[ September 15 2016 ]      AddinBox site moved from [ DION ] to [ SAKURA Internet ].  
      In addition, the old site remains until October 2017.
      New URL of this page http://addinbox.sakura.ne.jp/Breakthrough_P-Ctrl_Arrays_Eng.htm
 

AddinBox(Title_Logo)


Breakthrough in
        the Pseudo-Control-Array

                                                                              (Jpn. 1st Edition : 17 May 2004 )
                                                                              (Jpn. Last Edition : 11 Aug. 2014 )
                                                                              (Eng. 1st Translation: 24 Jul. 2014 )
                                                                              (Eng. Last Translation: 3 Nov. 2016 )

This document is translated from the document which I released in
Japanese in 2004 about the event handling of the Pseudo-Control-Array
of Excel-VBA.
      [ http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P-Ctrl_Arrays.htm  ( Jpn. )]

It begins with the Basics & the Problems of Pseudo-Control-Array and
explains the Problems & the Solution in a process reaching the technique
of the event handling at the same level as VisualBasic
.

    Everybody seems to call it "Control-Array" about VBA as far as I read the
    forum of the English zone. In Japan, we often call it "Pseudo-Control-Array".
    ( It is not a function implemented as a system like VB.  In a meaning of the
    alternative technique and not to be true Control-Array, we touch "Pseudo-"
    and call it with "Pseudo-Control-Array". )


So, in a meaning to leave the limitation of VBA and to realize the event
handling at the same level as VB, the title of the document of Japanese
becomes "Breakthrough in Pseudo". The opening sentence of the Japanese
document begins in this way.
          What is Pseudo?
                It is Pseudo-Control-Array.
          Then what is Pseudo-Control-Array?
                O.K. then, let's begin with the explanation of Pseudo-Control-Array.    ....

    ---- Contents  of  Breakthrough in the Pseudo-Control-Array (Jpn.)  ----
    Chap. 1: VB(Visual Basic) vs VBA(Visual Basic for Application)
    Chap. 2: Use of the Controls collection
    Chap. 3: Use of the Collection object
    Chap. 4: What is the Class module?
    Chap. 5: Use of the Class module
    Chap. 6: Problems to remain with the Pseudo-Control-Array
    Chap. 7: Operate the objects and the properties etc. in the UserForm module
                  from the Class module
    Chap. 8: At first we take a step forward from the Pseudo-Control-Array
    Chap. 9: Problems of the Pseudo-Control-Array becoming a hindrance
    Chap. 10: Breakthrough in the Pseudo-Control-Array
    Chap. 11: Sample macro

The volume of all the Japanese documents is about 5 times of this page.
This document translated Chap. 10 and Chap. 11 into English mainly.
The flow of following conversation is the contents from Chap. 1 to Chap. 9.

Furthermore ....
the class module of VBA cannot implement Enter and Exit events, but it
is enabled by API (ConnectToConnectionPoint).


      ( Because I who am poor at English am translating into English while using translation software,  
        there may be an odd expression. The mistranslation revises it sequentially. )

---- Contents  ( History of clsBpca ) ----
1. Question about the event handling of plural controls
2. Key point of Breakthrough in the Pseudo-Control-Array (Bpca)
3. Flow of the event handling of Bpca
4. Sample (Click event of CommandButton)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
5. General-purpose class module (clsBpca  Ver 2.0) and use example
    ( Ver 3.0 is released in New Site. )
    5-1. Using Exit event, if it is not a numeric, warning indication (TextBox)
          & Using Enter / Exit event, ActiveControl indication
            ( The use of the Enter / Exit event is possible since clsBpca (Ver2.0) ).
    5-2. Using Change event, highlight the color of the button (OptionButton)
    5-3. Using Change event, if it is not a numeric, warning indication (TextBox)
    5-4. Using KeyDown event, if it is not an alphanumeric character, warning indication (TextBox)
    5-5. Using Click event, Calculator
    5-6. Using MouseMove & Click event, Color palette form
    5-7. Using MouseMove & Click event, Calendar form
    5-8. Use example to the dynamic creation control
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
6. Implementation of the event handling by API (ConnectToConnectionPoint)
        The class module of VBA cannot implement Enter and Exit events,
        but it is enabled by API ( ConnectToConnectionPoint ).

7. ToggleLabel-Button class ( clsBpcaTglLbl  Ver 4.1 )
      Flag type button only with good points of Toggle, Option and CheckBox.   Figure 



[ Link to here ]

----  The question about the event handling of plural controls.  ----

I will express the contents of Chap. 1 to Chap. 9 by a simple conversation.

[ Y ] : You  ( you who read this )
[ K ] : K.Tsunoda  ( it's me )

Y : How does the event handling do it in Control-Array in VBA ?
K : In the first place, the Control-Array function same as VB is not implemented in VBA.
    Therefore, the event handling such as VB is not usable in VBA, too.

Y : Is there the alternative technique for Control-Array of VB in VBA ?
K : You can operate plural controls as follows using Controls-Collection-Object.
          Me.Controls ( "TextBox" & Idx ) .Value = "1234"
    And, you can define the event of plural controls by one event procedure using a class module.
    In this case, all the processing to perform by an event will define it in a class module.
    ( Pseudo-Control-Array )

Y : Then can we not describe an event handling on UserForm module?
    Is there the alternative technique for an event handling on UserForm?

K : You can define the Custom Event by using "Event declaration" and "RaiseEvent method"
    in the Class module.
    The class module takes charge of only the detection of the event of the control. When the
    class module detects an event, the class module fires a custom event to UserForm. So you
    become able to describe an event handling in custom event procedure in UserForm.

Y : When is it that "RaiseEvent method" was implemented ?
K : It is implemented in Excel2000.  The release of Excel2000 is June, 1999.

Y : From such past ?@Because this year is 2014, 15 years ago!
    Why does everybody not use it?@Will we be usable ?

K : Yes, you are usable it from past.

Y : Then can we handle the custom event of Control-Array, if we use the class module ?
K : No, you cannot do it.

Y : Why ?@You said that we could define the custom event using the class module !
K : Yes, you can define the custom event. But you cannot do it in Array.

Y : What do you mean ?
K : There is not any problem with defining the class object as an Array.
    Of course there is not any problem with "Event declaration" and "RaiseEvent method" in
    the class module either.

Y : Though nothing has any problem, why can we not do it ?
K : It does not have any problem to fire the custom event (Class module).
    However, the side to receive of the custom event has a problem (UserForm module).

Y : What do you mean ?
K : The definition of the object variable with "WithEvents" is necessary to receive an event.

Y : Yes, I know it.
K : Because it is a story of Control-Array, does the object variable define it in Array ?

Y : Yes, it is so.
K : A definition of Array cannot describe "WithEvents" keyword.
        -- Help : WithEvents --
        You can declare as many individual variables as you like using WithEvents,
        but you can't create arrays with WithEvents.

Y : Oh my God !
K : Do you understand it ?

Y : I can't help it, I give it up.
K : Do you give it up ?
    I released the document (Breakthrough in the Pseudo-Control Array : Japanese) in 2004.
    Thereafter, the technique to realize Control-Array including an Event Handling is becoming
    popular in Japan since 2004.  ( History by Internet Archive's Wayback Machine. -- Capture -- ).
    [ History of clsBpca ]

Y : Is there it ?   What kind of technique is it ?
K : Then let's begin explanation from now on.


[ Link to here ]

---  Key point of Breakthrough in the Pseudo-Control-Array ( Bpca )  ---

In VBA (Excel2000 and later), RaiseEvent method to fire a custom event is usable.

You can receive a custom event fired by RaiseEvent method by a class object variable
with "WithEvents".

Accordingly, Control-Array seems to be able to be realized, if you define the object of the
custom event class in an array variable.

However, it is impossible.

The reason why Control-Array is impossible in VBA is not to be able to describe
"WithEvents keyword" by array declaration.
        -- Help : WithEvents --
        You can declare as many individual variables as you like using WithEvents,
        but you can't create arrays with WithEvents.



This document explains on a technique to realize Control-Array in VBA avoiding the
limit  mentioned above.



At first I will list problems becoming a hindrance.

a) In the Class firing a custom event, , the Definition of "Event statement" and the
    Practice of "RaiseEvent statement" does not have any problem at all.

b) Because "WithEvents" keyword  is not described to the Array declaration of the
    class object in UserForm receiving the custom event, a custom event is not usable.

Conversely, if a class object definition does not have the array declaration on the
UserForm side, there is no problem.

But in this situation it contradicts it because it does not become the Control-Array
if you do not declare it as an array.


The key point of "Breakthrough in the Pseudo-Control-Array" is to divide the function
of the class into Fire-Events and Make-Array.



[ Link to here ]

---  Flow of the event handling of Bpca  ---

Because I prepare for an illustration, please understand the following explanation
while watching an illustration together.  ( Illustration of clsBpca Concept )


1. Applies the Class module by 2 steps ( clsBpca and clsBpcaCh ).

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2. 1st-Step class module "clsBpca" ( Parent class, It is only one. )

  2-1. It is the class to use for a definition of the control array in UserForm.
        But the variable to declare in this class does not define it with Array.

        Because it is not array, you can describe "WithEvents" keyword.
        In other words, you can receive a custom event from the class of this variable.

  2-2. The controls to make array on UserForm enroll in the collection in the 1st-Step
        class. ("Add" method of clsBpca)

  2-3. According to the number of controls registered with the collection, you create
        the 2nd-Step class object as the Dynamic Array in the 1st-Step class.

  2-4. You assign a control in the collection to an element of this array of the class
        object one by one.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3. 2nd-Step class module "clsBpcaCh" ( Child class; It is one per one control object. )

  3-1. This class object is created as a Dynamic array in the 1st-Step class.

  3-2. In the 2nd-Step class object (individual elements of the dynamic array), one control
        is assigned to each.

  3-3. The variable that control is assigned to here is not array.
        (The 2nd-Step class object is array, but the control variable in the individual array
         element is not array.)

  3-4. Because a control variable is not array, the variable can describe "WithEvents".

  3-5. In this way, in individual elements of the array of the 2nd-Step class, you can
        receive an event of the control in UserForm.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4. Fire Custom Event ( Flow of the event handling )

  4-1. An event of the control on UserForm fire by Macro-processing or the Operation
        of the person.

  4-2. You can receive an event of the control by a variable with "WithEvents" of the
        individual elements of the 2nd-Step class.

  4-3. For the notice of the event to the 1st-Step class, you call the method of the 1st-Step
        class from the 2nd-Step class. (In the individual elements of the 2nd-Step class, you
        keep the reference of the 1st-Step class object as the parent object.)

  4-4. You carry out "RaiseEvent" in the method of the 1st-Step class and fire the custom
        event.

  4-5. By a class obect variable (clsBpca) with "WithEvents" in UserForm, you receive the
        custom event of the 1st-Step class.


Then, with the click event of the CommandButton as an example, I will make a class
module by this technique.


[ Link to here ]

---  Sample (Click event of CommandButton)  ---

The sample macro which does "the indication of the weekday name" and "the change
of the button color" by the click of the weekday button (Sunday to Saturday).



I put off the presentation of the macro code of the class module.
At first, please watch the macro code of the UserForm module which is the use side.

===== UserForm module =========================

  Private WithEvents WeekBtn As clsBpcaCmd


  Private Sub UserForm_Initialize()
      Set WeekBtn = New clsBpcaCmd  ' Create Instance
      With WeekBtn
          .Add cmdSun    ' Register control in a class
          .Add cmdMon
          .Add cmdTue
          .Add cmdWed
          .Add cmdThu
          .Add cmdFri
          .Add cmdSat
          .Rgst          ' Create Child-class(clsBpcaCmdCh)
      End With
  End Sub


  Private Sub UserForm_Terminate()
      WeekBtn.Clear    ' Clean up and Release
      Set WeekBtn = Nothing
  End Sub


  Private Sub WeekBtn_Click(ByVal Index As Integer)
  Dim vntWeekName As Variant
  Dim i As Integer
    vntWeekName = Array("", "Sun", "Mon", "Tue", _
                            "Wed", "Thu", "Fri", "Sat")

    If (WeekBtn.Item(Index).BackColor = vbButtonFace) Then
      For i = 1 To 7
        If (i = Index) Then
          WeekBtn.Item(i).BackColor = &HCCFFFF  'Light Yellow
        Else
          WeekBtn.Item(i).BackColor = vbButtonFace
        End If
      Next i
    Else
      WeekBtn.Item(Index).BackColor = vbButtonFace
    End If

    MsgBox "[" & vntWeekName(Index) & _
            "] button is clicked (" & Index & ")"
  End Sub
 

It become the event coding at the same level as VB.
It is only the difference that Item property is sandwiched in between.
      VB :    cmdWeek(Index).BackColor
      Bpca : WeekBtn.Item(Index).BackColor


In addition, if you define the Item property as "Default Property" in a class module,
you can omit a description of "Item". Then, it is the completely same as VB.

In the general-purpose class module (clsBpca), I define the Item property as
"Default Property".

  ----  You can do it with the style that omitted "Item" (default property) as follows.  ----

    If (WeekBtn(Index).BackColor = vbButtonFace) Then
      For i = 1 To 7
        If (i = Index) Then
          WeekBtn(i).BackColor = &HCCFFFF   'Light Yellow
        Else
          WeekBtn(i).BackColor = vbButtonFace
        End If
      Next i
    Else
      WeekBtn(Index).BackColor = vbButtonFace
  End If


  ----  Method to define "Default Property"  ----

  You add the following the red-bold-faced part on the export file of the class module
  and take in a module by import again.
  ( The red-bold-faced part is invisible on the code window. )

  [ Export file  :  clsBpcaCmd.cls ]
  '---( Item property )---------------------------------------------
  Public Property Get Item(ByVal Index As Integer) As MSForms.CommandButton
  Attribute Item.VB_UserMemId = 0
  If ( blnRgst = True ) And _
      (Index > 0) And ( Index <= colCtrl.Count ) Then



Then we will watch the macro code of the class module.
Please watch while comparing it with a Illustration.

==== clsBpcaCmd module(1st-step class module) ====

  '------[ Event definition (Raise to the User-side) ]--------------
  Public Event Click (ByVal Index As Integer)

  '------[ Control-Array definition ]--------------------------
  'Child-class of clsBpcaCmd (Dynamic array)
  Private clsCtrlCh() As clsBpcaCmdCh
  'The storage of the controls on UserForm
  Private colCtrl As Collection 
  'Rgst method practice Flag : Done(True) , Not(False)
  Private blnRgst As Boolean    


  Private Sub Class_Initialize()
      Set colCtrl = New Collection     ' Create Instance
  End Sub


  Private Sub Class_Terminate()
      If (blnRgst = True) Or (Not (colCtrl Is Nothing)) Then
          Me.Clear
      End If
  End Sub


  '---( Add method )------------------------------------
  Public Sub Add(ByVal NewCtrl As MSForms.CommandButton)
      colCtrl.Add NewCtrl
  End Sub


  '---( Rgst method )------------------------------------
  Public Sub Rgst()
  Dim i As Integer
      If (blnRgst = True) Then
          'Done
      ElseIf (colCtrl.Count = 0) Then
          blnRgst = False
      Else
          ReDim clsCtrlCh(1 To colCtrl.Count)
          For i = 1 To colCtrl.Count
              ' Create Instance
              Set clsCtrlCh(i) = New clsBpcaCmdCh 
              With clsCtrlCh(i)
                  .Item = colCtrl(i)
                  .Index = i
                  .Parent = Me
              End With
          Next i
          blnRgst = True
      End If
  End Sub


  '---( Clear method )-------------------------
  Public Sub Clear()
  Dim i As Integer
      If (blnRgst = True) Then
          For i = 1 To colCtrl.Count
              clsCtrlCh(i).Clear
          Next i
      End If
      Set colCtrl = Nothing
      Erase clsCtrlCh
      blnRgst = False
  End Sub


  '---( Count property--------------------------------------
  Public Property Get Count() As Integer
      Count = colCtrl.Count
  End Property


  '---( Item property )---------------------------------------
  Public Property Get Item(ByVal Index As Integer) _
                  As MSForms.CommandButton
      If (blnRgst = True) And _
          (Index > 0) And (Index <= colCtrl.Count) Then
          Set Item = colCtrl(Index)
      Else
          Set Item = Nothing
      End If
  End Property


  '===========================================================
  '===== Method to be called from clsBpcaCmdCh =========
  '===========================================================

  Friend Sub RaiseClick(ByVal Index As Integer)
      RaiseEvent  Click(Index)
  End Sub
 

==== clsBpcaCmdCh module (2nd-step class module) ====

  Private WithEvents MyCtrl As MSForms.CommandButton
  Private MyIndex As Integer        'Index number of the control
  Private MyParent As clsBpcaCmd   'Referrence to the parent class
  Private blnParent As Boolean      '[Parent] register flag


  '---( Clear method )------------------------------------------
  Public Sub Clear()
      Set MyCtrl = Nothing
      Set MyParent = Nothing
      blnParent = False
      MyIndex = 0
  End Sub


  '---( Item property )-----------------------------------------
  Public Property Let Item(NewCtrl As MSForms.CommandButton)
      Set MyCtrl = NewCtrl
  End Property


  '---( Index property )----------------------------------------
  Public Property Let Index(NewIndex As Integer)
      MyIndex = NewIndex
  End Property


  '---( Parent property )---------------------------------------
  Public Property Let Parent(NewParent As clsBpcaCmd)
      blnParent = True
      Set MyParent = NewParent
  End Property


  '=============================================================
  '===== Receive an event of registered control ================
  '=============================================================
  'Receive an event of the control and notify the parent-class.

  Private Sub MyCtrl_Click()
      If (blnParent = True) Then
          MyParent.RaiseClick  MyIndex
      End If
  End Sub
 



This clsBpcaCmd and clsBpcaCmdCh class is a general-purpose class about the
click event of the CommandButton
.


(a) Not only Weekday-Button, you can use it for the array of other CommandButtons.

(b) On one UserFom, you can make the plural array of CommandButtons.
     You should only prepare plural class object definitions as follows.

        Private WithEvents CmdGrp1 As clsBpcaCmd
        Private WithEvents CmdGrp2 As clsBpcaCmd
                            :
                            :

(c) The number of CommandButtons which a class object can store away does not have
     the limit. The correction of the macro code of the class module cannot be necessary
     about the thing. You only merely repeat "Add method".

        With CmdGrp1
            .Add  CommandButton1
            .Add  CommandButton2
                            :
                            :

(d) About the CommandButton to create dynamically , you can handle a click event
    with this class.


However, it is inconvenient to be usable only by the Click event of CommandButton.
Because there are other controls such as TextBox, too, and there are other events
such as Change, too; ...

Therefore, I prepared General-purpose class (clsBpca  Ver 2.0) which supported
controls such as CommandButton,TextBox etc. and events such as Click,Change etc. .
In Ver2.0, a problem becomes available for Enter event etc. submitting in follows.

Please use it.



In fact, the following problem remains one more last.
      In the class module of VBA,
      we cannot define Enter, Exit, BeforeUpdate and AfterUpdate events.

These events are often used in error check and ActiveControl indication, etc.
I am disappointed at that I cannot use these events with Control-Array that
became available with much effort.

I explain why you cannot use the events of Enter etc. in a class module.

    (a) In the case of UserForm module ....
        For control placed in UserForm or control object (with WithEvents) defined
        in MsForms.TextBox etc., we can generate various event procedure from the
        list of Declarations of the module window top right corner. Naturally Enter
        event etc. are included in that, too.


    (b) In the case of Class module ....
        For control object (with WithEvents) defined in MsForms.TextBox etc., Enter
        event etc. are not included in the list of Declarations.


    (c) In the first place, the definitions of Enter,Exit,BeforeUpdate,AfterUpdate are not
        implemented in MsForms.TextBox etc. (You can confirm this by Object-Browser.)

    (d) The definitions of Enter, Exit, BeforeUpdate, AfterUpdate are implemented by
        MsForms.Control. (You can confirm this by Object-Browser, too.)

    (e) In the UserForm module, VBA links MsForms.Control to MsForms.TextBox etc..
        Because of support of VBA, we can build event procedures including Enter etc.
        for control of MsForms.Text etc. in UserForm module.

    (f) Class module does not have such a support.
        Therefore we cannot build events of Enter etc. from control of MsForms.Text etc.
        in class module.

In a class module, I will prepare an object (with WithEvents) defined in MsForms.Control.
Then I can generate a template of the event procedure of Enter from a list of Declalations.



Then, if you copy a control object from MsForms.TextBox to MsForms.Control, will
a problem be solved it?

Unfortunately then it is not solved.
    MsForms.Control from MsForms.TextBox cannot copy it.

The following copy becomes the error.
      Dim Ctrl1 As MsForms.TextBox
      Dim Ctrl2 As MsForms.Control
      Set Ctrl2 = Ctrl1      ' Error



For such a reason, Enter etc. are not available in the class module.


In addition, in General-purpose class (clsBpca Ver 2.0), a class module
is able to build events of Enter/Exit/BeforeUpdate/AfterUpdate by a
different method.


Please see below for the explanation of General-purpose class (clsBpca Ver 2.0).




[ Link to here ]

General-purpose class module (clsBpca  Ver 2.0)
                              and Usage example.


Event programming same as VisualBasic is enabled in VBA ,
only if you import clsBpca class module in your workbook as the Black-Box.
What you should do is ...
      At first, prepare for a variable of Control-Array (clsBpca object).
      Next, carry out "Rgst" method after repeating "Add" method.
      After that ... , describe event procedure commonly.
Only this.  ( Please check it in Sample Macro )

clsBpca supports the following controls and events, and it works in x64.
    -- Controls --
      Label , TextBox , CommandButton , OptionButton
      CheckBox , ComboBox , SpinButton , ToggleButton
          Among standard controls, ListBox/Frame/TabStrip/ MultiPage/ScrollBar is excluded
          from supported controls. It is the reason that is not placed much so that these controls
          becomes Control-Array.

    -- Events --
      Enter , Exit , BeforeUpdate , AfterUpdate
      Change , Click , DblClick , KeyDown , KeyPress , KeyUp
      MouseMove , MouseDown , MouseUp
      SpinDown , SpinUp , DropButtonClick
          The use of the Enter / Exit / BeforeUpdate / AfterUpdate event is possible
          since clsBpca (Ver2.0).
 In the class module of VBA, it cannot usually receive events
          of Enter , Exit , BeforeUpdate and AfterUpdate of the MsForms-Controls. It become able
          to receive the events by using API (ConnectToConnectionPoint).
          ( See below for further details. )


    Downloading and the help document of clsBpca are follows.

        [ clsBpca : Download & Help document ]    ( 11 Aug. 2014 Ver 2.0 release )
            ( Ver 3.0 is released in New Site. )





[ Link to here ]
1. Using Exit event, if it is not a numeric, warning indication (TextBox)
    & Using Enter / Exit event, ActiveControl indication

    The use of the Enter / Exit event is possible since clsBpca (Ver2.0).
    Enter / Exit event is defined by the name of OnEnter / OnExit in clsBpca.
    (Note) Because Enter / Exit events implement it by Windows-API, you cannot use it in Mac PC.

    About a method to implement Enter / Exit event in a class module.


  Video capture
  ( Bpca_EnterExitEvent.avi 1.3MB )


  Private WithEvents NumBox As clsBpca

  Private Sub UserForm_Initialize()
      Set NumBox = New clsBpca    ' Create Instance
      With NumBox
          .Add txtNum1
          .Add txtNum2
          .Add txtNum3
          .Add txtNum4
          .Rgst  BPCA_EnterExit
      End With
  End Sub

  Private Sub UserForm_Terminate()
      NumBox.Clear
      Set NumBox = Nothing
  End Sub

  Private Sub NumBox_OnEnter(ByVal Index As Integer)
      NumBox.ItmTxt(Index).BackColor = &HFFFFE0    'LightCyan
  End Sub

  Private Sub NumBox_OnExit(ByVal Index As Integer, _
                        ByVal Cancel As MSForms.ReturnBoolean)
      If (NumBox.ItmTxt(Index).Value = "") Then
          'Empty is OK
      ElseIf IsNumeric(NumBox.ItmTxt(Index).Value) Then
          'Numeric is OK
      Else
          'Not Numeric is Error
          NumBox.ItmTxt(Index).BackColor = &HCCCCFF    'Light Red
          Beep
          Cancel = True
          Exit Sub
      End If

      NumBox.ItmTxt(Index).BackColor = vbWindowBackground
  End Sub



[ Link to here ]
2. Using Change event, highlight the color of the button (OptionButton)



  Private WithEvents OptBtn As clsBpca

  Private Sub UserForm_Initialize()
    Set OptBtn = New clsBpca    ' Create Instance
    With OptBtn
      .Add OptionButton1
      .Add OptionButton2
      .Add OptionButton3
      .Add OptionButton4
      .Add OptionButton5
      .Rgst BPCA_Change
    End With
  End Sub

  Private Sub UserForm_Terminate()
    OptBtn.Clear
    Set OptBtn = Nothing
  End Sub

  Private Sub OptBtn_Change(ByVal Index As Integer)
    With OptBtn.ItmOpt(Index)
      If (.Value = True) Then
        .BackColor = &HCCCCFF      'Light Red
      Else
        .BackColor = Me.BackColor
      End If
    End With
  End Sub

  Private Sub cmdOptReset_Click()
  Dim i As Integer
    For i = 1 To 5
      With OptBtn.ItmOpt (i)
        If (.Value = True) Then
          'I leave the change of the color to
          'the Change event mentioned above
          .Value = False
        End If
      End With
    Next i
  End Sub



[ Link to here ]
3. Using Change event, if it is not a numeric, warning indication (TextBox)



  Private WithEvents NumBox As clsBpca

  Private Sub UserForm_Initialize()
    Set NumBox = New clsBpca    ' Create Instance
    With NumBox
      .Add txtNum1
      .Add txtNum2
      .Add txtNum3
      .Rgst BPCA_Change
    End With
  End Sub

  Private Sub UserForm_Terminate()
    NumBox.Clear
    Set NumBox = Nothing
  End Sub

  Private Sub NumBox_Change(ByVal Index As Integer)
    With NumBox.ItmTxt(Index)
      If IsNumeric(.Value) Then
        .BackColor = vbWindowBackground
      Else
        .BackColor = &HCCCCFF    'Light Red
      End If
    End With
  End Sub



[ Link to here ]
4. Using KeyDown event, if it is not an alphanumeric character, warning indication (TextBox)



  Private WithEvents AlfaNumBox As clsBpca

  Private Sub UserForm_Initialize()
    Set AlfaNumBox = New clsBpca    ' Create Instance
    With AlfaNumBox
      .Add txtAN1
      .Add txtAN2
      .Add txtAN3
      .Rgst BPCA_KeyDown
    End With
  End Sub

  Private Sub UserForm_Terminate()
    AlfaNumBox.Clear
    Set AlfaNumBox = Nothing
  End Sub

  Private Sub AlfaNumBox_KeyDown _
        (ByVal Index As Integer, _
        ByVal KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
  Dim i As Integer
  Dim blnERR As Boolean
    With AlfaNumBox.ItmTxt(Index)
      Select Case KeyCode
        Case vbKeyTab, vbKeyReturn, vbKeyUp, vbKeyDown
          'Type an input end key
          blnERR = False
          For i = 1 To Len(.Value)
            Select Case Mid(.Value, i, 1)
              Case "0" To "9"
              Case "A" To "Z"
              Case "a" To "z"
              Case Else
                blnERR = True
            End Select
          Next i
          If (blnERR = False) Then
            .BackColor = vbWindowBackground
          Else
            .BackColor = &HCCCCFF    'Light Red
          End If
        Case Else
          'Inputting now
      End Select
    End With
  End Sub



[ Link to here ]
5. Using Click event, Calculator



  Private WithEvents CalcNum As clsBpca
  Private WithEvents CalcOpr As clsBpca
  Private intOperate As Integer  'Operator of Calculator

  Private Sub UserForm_Initialize()
  Dim i As Integer
    txtCalcResult.Value = ""
    txtCalcBuff.Value = ""
    intOperate = 0

    Set CalcNum = New clsBpca    'Create Instance
    With CalcNum
      For i = 1 To 9
        .Add Me.Controls("cmdCalc" & i)
      Next i
      .Add cmdCalc0      '[10]
      .Add cmdCalcSign    '[11]
      .Add cmdCalcPoint  '[12]
      .Rgst BPCA_Click
    End With

    Set CalcOpr = New clsBpca    'Create Instance
    With CalcOpr
      .Add cmdCalcClear    '[1]
      .Add cmdCalcMulti    '[2]
      .Add cmdCalcDivide  '[3]
      .Add cmdCalcPlus    '[4]
      .Add cmdCalcMinus    '[5]
      .Add cmdCalcEQ      '[6]
      .Rgst BPCA_Click
    End With
  End Sub

  Private Sub UserForm_Terminate()
    CalcNum.Clear
    CalcOpr.Clear
    Set CalcNum = Nothing
    Set CalcOpr = Nothing
  End Sub

  Private Sub CalcNum_Click(ByVal Index As Integer)
  Dim strWK As String
    If (intOperate = 6) And (Index <> 11) Then
      strWK = ""
      intOperate = 0
    Else
      strWK = txtCalcResult.Value
    End If

    Select Case Index
      Case 1 To 9
        Select Case strWK
          Case "0"
            strWK = Index    'Omit 0 of the top
          Case "-0"
            strWK = "-" & Index    'Omit 0 of the top
          Case Else
            strWK = strWK & Index
        End Select
      Case 10
        Select Case strWK
          Case "0", "-0", "-"
            'Let it ride
          Case Else
            strWK = strWK & "0"
        End Select
      Case 11  'Sign (Plus <--> Minus)
        If (Left(strWK, 1) = "-") Then
          strWK = Mid(strWK, 2)
        Else
          strWK = "-" & strWK
        End If
      Case 12  'Decimal point
        If (InStr(strWK, ".") = 0) Then
          strWK = strWK & "."
        End If
    End Select
    txtCalcResult.Value = strWK
  End Sub

  Private Sub CalcOpr_Click(ByVal Index As Integer)
  Dim i As Integer
    Select Case Index
      '[AC: All Clear]
      Case 1
        txtCalcResult.Value = ""
        txtCalcBuff.Value = ""
        intOperate = 0
        For i = 2 To 5
          CalcOpr.ItmCmd(i).BackColor = vbButtonFace
        Next i
      '[*][/][+][-]
      Case 2 To 5
        If (intOperate >= 2) And (intOperate <= 5) Then
          Call Calc_Sub
        End If
        intOperate = Index
        txtCalcBuff.Value = txtCalcResult.Value
        txtCalcResult.Value = ""
        For i = 2 To 5
          With CalcOpr.ItmCmd(i)
            If (i = Index) Then
              .BackColor = &HC0FFFF  'Light Yellow
            Else
              .BackColor = vbButtonFace
            End If
          End With
        Next i
      '[=]
      Case 6
        Call Calc_Sub
        intOperate = 6
        For i = 2 To 5
          CalcOpr.ItmCmd(i).BackColor = vbButtonFace
        Next i
    End Select
  End Sub

  Private Sub Calc_Sub()
  Dim dblNum1 As Double
  Dim dblNum2 As Double
    dblNum1 = Val(txtCalcBuff.Value)
    dblNum2 = Val(txtCalcResult.Value)
    Select Case intOperate
      Case 2
        txtCalcResult.Value = CStr(dblNum1 * dblNum2)
      Case 3
        If (dblNum2 <> 0) Then
          txtCalcResult.Value = CStr(dblNum1 / dblNum2)
        Else
          txtCalcResult.Value = "0"
        End If
      Case 4
        txtCalcResult.Value = CStr(dblNum1 + dblNum2)
      Case 5
        txtCalcResult.Value = CStr(dblNum1 - dblNum2)
    End Select
    txtCalcBuff.Value = ""
  End Sub



[ Link to here ]
6. Using MouseMove & Click event, Color palette form ( Layout before Excel2003 )



  ' Placement of the color index (Layout before Excel2003)
  ' A control name (lblPalette99) is acquired so
  ' that it is placed follows.
  '
  ' [01] [53] [52] [51] [49] [11] [55] [56]
  ' [09] [46] [12] [10] [14] [05] [47] [16]
  ' [03] [45] [43] [50] [42] [41] [13] [48]
  ' [07] [44] [06] [04] [08] [33] [54] [15]
  ' [38] [40] [36] [35] [34] [37] [39] [02]
  ' ---------------------------------------
  ' [17] [18] [19] [20] [21] [22] [23] [24]
  ' [25] [26] [27] [28] [29] [30] [31] [32]


  Private WithEvents Palette As clsBpca

  Private Sub UserForm_Initialize()
  Dim i As Integer
    lblPaletteRGB.Caption = ""
    Set Palette = New clsBpca    'Create Instance
    With Palette
      For i = 1 To 56
        .Add Me.Controls("lblPalette" & i)
      Next i
      .Add lblPaletteFrame    '(57)
      .Rgst BPCA_MouseMove + BPCA_Click
    End With
    For i = 1 To 56
      With Palette.ItmLbl(i)
        .BackColor = ThisWorkbook.Colors(i)
        .ControlTipText = _
            "(" & Format(i, "00") & ") x" & _
            Right("000000" & Hex(ThisWorkbook.Colors(i)), 6)
      End With
    Next i
  End Sub

  Private Sub UserForm_Terminate()
    Palette.Clear
    Set Palette = Nothing
  End Sub

  Private Sub Palette_Click(ByVal Index As Integer)
    If (Index <= 56) Then
      lblPaletteRGB.BackColor = Palette.ItmLbl(Index).BackColor
    End If
  End Sub

  Private Sub Palette_MouseMove _
          (ByVal Index As Integer, _
          ByVal Button As Integer, _
          ByVal Shift As Integer, _
          ByVal X As Single, ByVal Y As Single)
  Dim i As Integer
    Select Case Index
      Case 1 To 56
        'When mouse cursor overlaps with a palette,
        'only the palette makes a convex.

        For i = 1 To 56
          With Palette.ItmLbl(i)
            If (i = Index) Then
              If (.SpecialEffect = fmSpecialEffectEtched) Then
                .SpecialEffect = fmSpecialEffectRaised
              End If
            Else
              If (.SpecialEffect = fmSpecialEffectRaised) Then
                .SpecialEffect = fmSpecialEffectEtched
              End If
            End If
          End With
        Next i
      Case Else
        'If mouse cursor deviates from the palette,
        'it goes all back up in a flat.
        '[ lblPaletteFrame(57) ]

        For i = 1 To 56
          With Palette.ItmLbl(i)
            If (.SpecialEffect = fmSpecialEffectRaised) Then
              .SpecialEffect = fmSpecialEffectEtched
            End If
          End With
        Next i
    End Select
  End Sub



[ Link to here ]
7. Using MouseMove & Click event, Calendar form

  Video capture
  ( Bpca_CalendarForm.avi 0.9MB )


  Private WithEvents CalBtn As clsBpca
  Private dtmBaseDate As Date
  Private dtmFirstDate As Date
  Private dtmLastDate As Date

  Private Sub UserForm_Initialize()
  Dim i As Integer
    Set CalBtn = New clsBpca    ' Create Instance
    With CalBtn
      For i = 1 To 37
        .Add Me.Controls("lblDay" & i)
      Next i
      .Rgst BPCA_Click + BPCA_MouseMove
    End With
    dtmFirstDate = DateSerial(Year(Date), Month(Date), 1)
    Call CalendarMake
  End Sub

  Private Sub UserForm_MouseMove( _
            ByVal Button As Integer, ByVal Shift As Integer, _
            ByVal X As Single, ByVal Y As Single)
    'All highlights are turned off by handing Zero
    Call CalMousePoint(0)
  End Sub

  Private Sub UserForm_Terminate()
    CalBtn.Clear
    Set CalBtn = Nothing
  End Sub

  Private Sub CalBtn_Click(ByVal Index As Integer)
    MsgBox "Click Date = " & _
        Format(dtmBaseDate + Index - 1, "d mmm. yyyy")
  End Sub

  Private Sub CalBtn_MouseMove( _
            ByVal Index As Integer, _
            ByVal Button As Integer, ByVal Shift As Integer, _
            ByVal X As Single, ByVal Y As Single)
    'Highlight the button of the mouse position
    Call CalMousePoint(Index)
  End Sub

  Private Sub spnMonth_SpinDown()
    dtmFirstDate = DateSerial(Year(dtmFirstDate), _
                                      Month(dtmFirstDate) - 1, 1)
    Call CalendarMake
  End Sub

  Private Sub spnMonth_SpinUp()
    dtmFirstDate = DateSerial(Year(dtmFirstDate), _
                                      Month(dtmFirstDate) + 1, 1)
    Call CalendarMake
  End Sub

  Private Sub CalendarMake()
  Dim dtmWK As Date
  Dim i As Integer
    dtmLastDate = DateSerial(Year(dtmFirstDate), _
                                    Month(dtmFirstDate) + 1, 0)
    dtmBaseDate = dtmFirstDate - Weekday(dtmFirstDate) + 1

    lblMonth.Caption = Format(dtmFirstDate, "mmm. yyyy")
    For i = 1 To 37
      dtmWK = dtmBaseDate + i - 1
      With CalBtn.ItmLbl(i)
        If (dtmWK >= dtmFirstDate) And (dtmWK <= dtmLastDate) Then
          .Caption = Day(dtmWK)
          .Visible = True
          If (dtmWK = Date) Then
            .ControlTipText = "Today"
            .Font.Underline = True
          Else
            .ControlTipText = ""
            .Font.Underline = False
          End If
        Else
          .Visible = False
        End If
      End With
    Next i
  End Sub

  '---- Highlight the button of the mouse position ----
  Private Sub CalMousePoint(ByVal Index As Integer)
  Dim i As Integer
    For i = 1 To 37
      With CalBtn.ItmLbl(i)
        If (i = Index) Then
          If (.BackColor = Me.BackColor) Then
            .BackColor = &HFFFFC0    'Thin light blue
          End If
        Else
          If (.BackColor <> Me.BackColor) Then
            .BackColor = Me.BackColor
          End If
        End If
      End With
    Next i
  End Sub


 You can make a general-purpose Calendar Tool
       from the UserForm (frmBpca3) mentioned above.


 Please perform import (export & import) of the calendar form (frmBpca3)
 in your workbook from Bpca_Class_V20E.xls.


 === frmBpca3 module (mentioned adove) ===
     ( + : Add line , - : Delete line )
 
 + 'Serial_Number(Date clicked) or [-1](Cancel)
 + Public ReturnValue As Date

   Private WithEvents CalBtn As clsBpca
       :
       :
 
 + Private Sub UserForm_QueryClose _
 +           (Cancel As Integer, CloseMode As Integer)
 +   If (CloseMode = vbFormControlMenu) Then
 +     Cancel = True
 +     ReturnValue = -1    'Cancel
 +     Me.Hide
 +   End If
 + End Sub
 
   Private Sub CalBtn_Click(ByVal Index As Integer)
 -   MsgBox "Click Date = " & _
 -         Format(dtmBaseDate + Index - 1, "d mmm. yyyy")
 +   ReturnValue = dtmBaseDate + Index - 1
 +   Me.Hide
   End Sub
 
 
 === Standard module ===
   Public Function CalendarForm() As Date
     frmBpca3.Show
     CalendarForm = frmBpca3.ReturnValue
     Unload frmBpca3
   End Function

 === Any UserForm ===
   Private Sub TextBox1_DblClick _
         (ByVal Cancel As MSForms.ReturnBoolean)
   Dim DateWk As Date
     DateWk = CalendarForm
     If (DateWk = -1) Then
       'Cancel
     Else
       TextBox1.Value = Format(DateWk, "yyyy/m/d")
     End If
     Cancel = True
   End Sub
 
   Private Sub TextBox2_DblClick _
         (ByVal Cancel As MSForms.ReturnBoolean)
   Dim DateWk As Date
     DateWk = CalendarForm
     If (DateWk = -1) Then
       'Cancel
     Else
       TextBox2.Value = Format(DateWk, "yyyy/m/d")
     End If
     Cancel = True
   End Sub



The macro of the calendar form becomes the Map selection form
if you change the placement of Label controls.
The figure below is Japanese map form (selection of the prefecture).
This sample is not included in the distribution file.
 
  Video capture
  ( Bpca_JapanMapForm.avi 1.6MB )


[ Link to here ]
8. Use example to dynamic creation control    ( 3 Nov. 2016 added )

    It create 2-5 lines of control sets dynamically.
    (The 1st line has been made at the time of a design)
    You delete the added controls and can go back up in initial state.
    [ Bpca_DynamicCreate_Eng.xls ]



 'It store a Control-Name not an Object in colAddCtrl (in consideration of Remove).
 Private colAddCtrl As Collection

 Private WithEvents AddChkEnable As clsBpca
 Private WithEvents AddTxtName As clsBpca
 Private WithEvents AddTxtAddr As clsBpca
 '---------------------------------------------------------
 Private Sub Bpca_Clear()
    AddChkEnable.Clear
    AddTxtName.Clear
    AddTxtAddr.Clear

    Set AddChkEnable = Nothing
    Set AddTxtName = Nothing
    Set AddTxtAddr = Nothing
 End Sub
 '---------------------------------------------------------
 Private Sub Bpca_Registration()
 Dim vntArray As Variant
 Dim j As Integer

    Set AddChkEnable = New clsBpca
    Set AddTxtName = New clsBpca
    Set AddTxtAddr = New clsBpca

    For j = 1 To colAddCtrl.Count
        vntArray = colAddCtrl(j)
        AddChkEnable.Add Me.Controls(vntArray(1))  'chkEnable
        AddTxtName.Add Me.Controls(vntArray(2))    'txtName
        AddTxtAddr.Add Me.Controls(vntArray(3))    'txtAddr
    Next j

    AddChkEnable.Rgst BPCA_Change + BPCA_EnterExit
    AddTxtName.Rgst BPCA_Change + BPCA_EnterExit
    AddTxtAddr.Rgst BPCA_Change + BPCA_EnterExit
 End Sub
 '---------------------------------------------------------
 Private Sub DisplayListBox(ByVal Arg As String)
    With ListBox1
        .AddItem Arg
        .ListIndex = .ListCount - 1
    End With
 End Sub
 '---------------------------------------------------------
 Private Sub UserForm_Initialize()
    'For 1st lines(lblNo1 & chkEnable1 & txtName1 & txtAddr1) which are prepared by a design.
    Set colAddCtrl = New Collection
    colAddCtrl.Add Array("lblNo1", "chkEnable1", "txtName1", "txtAddr1")

    Call Bpca_Registration

    txtName1.SetFocus
 End Sub
 '---------------------------------------------------------
 Private Sub UserForm_Terminate()
    Set colAddCtrl = Nothing
    Call Bpca_Clear
 End Sub
 '---------------------------------------------------------
 Private Sub cmdAddLine_Click()
 Dim ctlLbl As MSForms.Label
 Dim ctlChk As MSForms.CheckBox
 Dim ctlTxtName As MSForms.TextBox
 Dim ctlTxtAddr As MSForms.TextBox
 Dim vntArray As Variant
 Dim j As Integer

    If (colAddCtrl.Count = 5) Then  ' Max 5 line
        Beep
        Exit Sub
    End If

    j = colAddCtrl.Count + 1

    Set ctlLbl = Me.Controls.Add("Forms.Label.1")
    With ctlLbl
        .Name = "lblNo" & j
        .Top = 56 + 30 * (j - 1)
        .Left = 12
        .Height = 12
        .Width = 24
        .Caption = "( " & j & " )"
    End With

    Set ctlChk = Me.Controls.Add("Forms.CheckBox.1")
    With ctlChk
        .Name = "chkEnable" & j
        .Top = 54 + 30 * (j - 1)
        .Left = 45
        .Height = 20
        .Width = 20
        .Caption = ""
        .Value = True
    End With

    Set ctlTxtName = Me.Controls.Add("Forms.TextBox.1")
    With ctlTxtName
        .Name = "txtName" & j
        .Top = 54 + 30 * (j - 1)
        .Left = 72
        .Height = 18
        .Width = 54
        .Enabled = True
        .Value = ""
    End With

    Set ctlTxtAddr = Me.Controls.Add("Forms.TextBox.1")
    With ctlTxtAddr
        .Name = "txtAddr" & j
        .Top = 54 + 30 * (j - 1)
        .Left = 135
        .Height = 18
        .Width = 54
        .Enabled = True
        .Value = ""
    End With

    colAddCtrl.Add Array(ctlLbl.Name, ctlChk.Name, ctlTxtName.Name, ctlTxtAddr.Name)

    'Reset for created controls (chkEnableX & txtNameX & txtAddrX)
    Call Bpca_Clear
    Call Bpca_Registration

    ctlTxtName.SetFocus
 End Sub
 '---------------------------------------------------------
 Private Sub cmdEraseLine_Click()
 Dim vntArray As Variant
 Dim j As Integer

    If (colAddCtrl.Count = 1) Then
        Beep
        Exit Sub
    End If

    'In the case of deletion, please carry it out in order of
    '[Bpca_Clear > Control-Remove > Bpca_Registration].


    Call Bpca_Clear

    For j = colAddCtrl.Count To 2 Step -1
        vntArray = colAddCtrl(j)
        Me.Controls.Remove vntArray(0)      'lblNo
        Me.Controls.Remove vntArray(1)      'chkEnable
        Me.Controls.Remove vntArray(2)      'txtName
        Me.Controls.Remove vntArray(3)      'txtAddr
    Next j

    chkEnable1.Value = True
    With txtName1
        .Enabled = True
        .Value = ""
    End With
    With txtAddr1
        .Enabled = True
        .Value = ""
    End With

    Set colAddCtrl = Nothing
    Set colAddCtrl = New Collection
    colAddCtrl.Add Array("lblNo1", "chkEnable1", "txtName1", "txtAddr1")

    Call Bpca_Registration

    Call DisplayListBox("---------- Erase (2)-(5) lines ----------")
    txtName1.SetFocus
 End Sub
 '---------------------------------------------------------
 Private Sub AddChkEnable_OnEnter(ByVal Index As Integer)
    With AddChkEnable.Item(Index)
        .BackColor = &HFFFFE0    'LightCyan
        Call DisplayListBox(.Name & " : Enter Value=" & .Value)
    End With
 End Sub

 Private Sub AddChkEnable_Change(ByVal Index As Integer)
    With AddChkEnable.Item(Index)
        Call DisplayListBox(.Name & " : Change Value=" & .Value)
    End With

    'The Index number of TextBox becomes same as CheckBox of the same line.
    AddTxtName.Item(Index).Enabled = AddChkEnable.Item(Index).Value
    AddTxtAddr.Item(Index).Enabled = AddChkEnable.Item(Index).Value
 End Sub

 Private Sub AddChkEnable_OnExit(ByVal Index As Integer, ByVal Cancel As MSForms.ReturnBoolean)
    With AddChkEnable.Item(Index)
        .BackColor = vbButtonFace
        Call DisplayListBox(.Name & " : Exit Value=" & .Value)
    End With
 End Sub
 '---------------------------------------------------------
 Private Sub AddTxtName_OnEnter(ByVal Index As Integer)
    With AddTxtName.Item(Index)
        .BackColor = &HFFFFE0    'LightCyan
        Call DisplayListBox(.Name & " : Enter Value=" & .Value)
    End With
 End Sub

 Private Sub AddTxtName_Change(ByVal Index As Integer)
    With AddTxtName.Item(Index)
        Call DisplayListBox(.Name & " : Change Value=" & .Value)
    End With
 End Sub

 Private Sub AddTxtName_OnExit(ByVal Index As Integer, ByVal Cancel As MSForms.ReturnBoolean)
    With AddTxtName.Item(Index)
        .BackColor = vbWindowBackground
        Call DisplayListBox(.Name & " : Exit Value=" & .Value)
    End With
 End Sub
 '---------------------------------------------------------
 Private Sub AddTxtAddr_OnEnter(ByVal Index As Integer)
    With AddTxtAddr.Item(Index)
        .BackColor = &HFFFFE0    'LightCyan
        Call DisplayListBox(.Name & " : Enter Value=" & .Value)
    End With
 End Sub

 Private Sub AddTxtAddr_Change(ByVal Index As Integer)
    With AddTxtAddr.Item(Index)
        Call DisplayListBox(.Name & " : Change Value=" & .Value)
    End With
 End Sub

 Private Sub AddTxtAddr_OnExit(ByVal Index As Integer, ByVal Cancel As MSForms.ReturnBoolean)
    With AddTxtAddr.Item(Index)
        .BackColor = vbWindowBackground
        Call DisplayListBox(.Name & " : Exit Value=" & .Value)
    End With
 End Sub




[ AddinBox Home (Japanese) ]  [ English Home ]  AddinBox_Banner


AddinBox ( K.Tsunoda in Japan ) CopyRight(C) 2014 Allrights Reserved.