-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathEXCEL_CHART_RANGE_LIBR.bas
executable file
·99 lines (79 loc) · 3.68 KB
/
EXCEL_CHART_RANGE_LIBR.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Attribute VB_Name = "EXCEL_CHART_RANGE_LIBR"
'--------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------
Option Explicit 'Requires that all variables to be declared explicitly.
Option Base 1 'The "Option Base" statement allows to specify 0 or 1 as the
'default first index of arrays.
'--------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------
'************************************************************************************
'************************************************************************************
'FUNCTION : EXCEL_CHART_RANGE_SELECT_FUNC
'DESCRIPTION :
'LIBRARY : EXCEL_CHART
'GROUP : LOAD
'ID : 001
'AUTHOR : RAFAEL NICOLAS FERMIN COTA
'************************************************************************************
'************************************************************************************
Function EXCEL_CHART_RANGE_SELECT_FUNC() As Excel.Range
On Error GoTo ERROR_LABEL
ACTIVATE_FLAG = False ' True to re-activate the input range
Set DATA_RNG = EXCEL_CHART_RANGE_MSG_FUNC("Please select the range containing the DATA POINTS" & Chr(13) & "(press select a single column)")
If EXCEL_CHART_RANGE_CHECK_FUNC(DATA_RNG) Then
MsgBox "Incorrect Input Data !"
End
ElseIf Not (EXCEL_CHART_NUMERIC_CHECK_FUNC(DATA_RNG)) Then
MsgBox "Incorrect Input Data !"
End
End If
Exit Function
ERROR_LABEL:
Set EXCEL_CHART_RANGE_SELECT_FUNC = Nothing
End Function
'************************************************************************************
'************************************************************************************
'FUNCTION : EXCEL_CHART_RANGE_MSG_FUNC
'DESCRIPTION :
'LIBRARY : EXCEL_CHART
'GROUP : LOAD
'ID : 002
'AUTHOR : RAFAEL NICOLAS FERMIN COTA
'************************************************************************************
'************************************************************************************
Private Function EXCEL_CHART_RANGE_MSG_FUNC(ByVal BOX_MSG_STR As String) As Excel.Range
On Error GoTo ERROR_LABEL
Set EXCEL_CHART_RANGE_MSG_FUNC = Nothing
Set EXCEL_CHART_RANGE_MSG_FUNC = Application.InputBox(BOX_MSG_STR, "Select Range", Selection.Address, , , , , 8)
Exit Function
ERROR_LABEL:
Set EXCEL_CHART_RANGE_MSG_FUNC = Nothing
End Function
'************************************************************************************
'************************************************************************************
'FUNCTION : EXCEL_CHART_RANGE_CHECK_FUNC
'DESCRIPTION :
'LIBRARY : EXCEL_CHART
'GROUP : LOAD
'ID : 003
'AUTHOR : RAFAEL NICOLAS FERMIN COTA
'************************************************************************************
'************************************************************************************
Private Function EXCEL_CHART_RANGE_CHECK_FUNC(ByRef SRC_RNG As Excel.Range) As Boolean
Dim CELL_RNG As Excel.Range
On Error GoTo ERROR_LABEL
EXCEL_CHART_RANGE_CHECK_FUNC = True
If SRC_RNG.Rows.COUNT > 0 And SRC_RNG.Columns.COUNT = 1 Then
EXCEL_CHART_RANGE_CHECK_FUNC = False
Exit Function
End If
For Each CELL_RNG In SRC_RNG.Cells
If Not (Application.WorksheetFunction.IsNumber(CELL_RNG.value)) Then
EXCEL_CHART_RANGE_CHECK_FUNC = False
Exit Function
End If
Next CELL_RNG
Exit Function
ERROR_LABEL:
EXCEL_CHART_RANGE_CHECK_FUNC = True
End Function