VERSION 5.00
Begin VB.Form frmSESIMDDE 
   Caption         =   "SESIM_DDE"
   ClientHeight    =   1335
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3885
   LinkMode        =   1  'Source
   LinkTopic       =   "SESIM_DDE"
   ScaleHeight     =   1335
   ScaleWidth      =   3885
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtDDE_out 
      Height          =   375
      Left            =   240
      LinkTopic       =   "excel|temp"
      TabIndex        =   1
      Text            =   "txtDDE_out"
      Top             =   720
      Width           =   3375
   End
   Begin VB.TextBox txtDDE_in 
      Height          =   375
      Left            =   240
      LinkItem        =   "txtDDE_in"
      TabIndex        =   0
      Text            =   "txtDDE_in"
      Top             =   240
      Width           =   3375
   End
End
Attribute VB_Name = "frmSESIMDDE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************
'*** This module contains code to handle the communication with the
'*** Excel RePorTGENerator. The communication uses the DDE technique.
'*** The frmSESIMDDE form recieves commands from RPTGEN to the
'*** txtDDE_in textbox, processes the commands and weites the result
'*** back to the RPTGEN through the txtDDE_out textbox .
'***
'*** The syntax of the incoming command string is separated using the
'*** "" sign as follows (positions 1 - 4 are required):
'***
'*** 1. Analysis variable
'*** 2. Excel result destination (format r1c1)
'*** 3. Statistic
'*** 4. Year of analysis
'*** 5. Selection variable
'*** 6. Selection operator
'*** 7. Selection value
'***
'*** NOTE1: No extensive error checking of the DDE command strings is done
'*** here since it is assumed to be done in RPTGEN.
'*** NOTE2: The module uses methods within frmGlobalSelection to handle the
'*** conditions set on the analyses.

Option Explicit
Option Base 1

'*** Temporary selection vectors
Dim tempselect_i() As Long, tempselect_h() As Long

'*** Old contents of txtDDE_in - to prevent multiple calculations of the same statistic
Dim oldtxt As String

'***********************************************************************
'*** Sub txtDDE_in_Change() is launched when Excel sends a command to
'*** SESIM.
'***********************************************************************

Private Sub txtDDE_in_Change()

   Dim commandstring(1 To 7) As String
   Dim analysis_var As String, statistic As String, year As String
   Dim operator As String, selection_var As String, value As String
   Dim sheet As String, cell As String, destination As String
   Dim result As Double
   Dim retcode As Byte
   Dim i As Integer
  
   '*** The DDE link launces multiple calls (why is this? CHECK UP!)
   If txtDDE_in.text = oldtxt Then Exit Sub
  
   '*** Initialize SESIM if it is not already done
   If init_done = 0 Then Call Initsesim
   
   '*** Load frmGlobalSelection if not already loaded
   If controlcenter.CmdGlobalSelection.enabled = True Then _
      controlcenter.CmdGlobalSelection_Click
   
   '*** Check what type of command has been sent
   Call check_DDEcommandtype(txtDDE_in, commandstring, retcode)
   
   '*** Set commandstring arguments
   analysis_var = commandstring(1)
   destination = commandstring(2)
   statistic = commandstring(3)
   year = commandstring(4)
   selection_var = commandstring(5)
   operator = commandstring(6)
   value = commandstring(7)
         
   '*** Handle the various types of commands
   Select Case retcode
   
      '*** Global condition
      Case 1
         Call set_global_condition(selection_var, operator, value)
         
      '*** Analysis with no conditions
      Case 2
         result = calculate_statistic(analysis_var, statistic)
         
         '*** Send to Excel
         Call send2excel(destination, CStr(result))
      
      '*** Analysis with conditions on the analysis variable
      Case 3
      
         '*** Temporary storage of selection vectors
         tempselect_i = select_i
         tempselect_h = select_h
          
         Call set_global_condition(analysis_var, operator, value)
         result = calculate_statistic(analysis_var, statistic)
         
         '*** Now delete the last selection item that was added above
         nSelItems = nSelItems - 1
         ReDim Preserve SelLst(maxi(1, nSelItems))
         
         '*** Reset the selection vectors to their previous state
         select_i = tempselect_i
         select_h = tempselect_h
         
         '*** Redraw the frmGlobalSelection grid
         frmGlobalSelection.RedrawGrid
            
         '*** Send to Excel
         Call send2excel(destination, CStr(result))
            
      '*** Analysis with conditions on the selection variable
      Case 4
         
         '*** Temporary storage of selection vectors
         tempselect_i = select_i
         tempselect_h = select_h
         
         Call set_global_condition(selection_var, operator, value)
         result = calculate_statistic(analysis_var, statistic)
         
         '*** Now delete the last selection item that was added above
         nSelItems = nSelItems - 1
         ReDim Preserve SelLst(maxi(1, nSelItems))
         
         '*** Reset the selection vectors to their previous state
         select_i = tempselect_i
         select_h = tempselect_h
         
         '*** Redraw the frmGlobalSelection grid
         frmGlobalSelection.RedrawGrid
            
         '*** Send to Excel
         Call send2excel(destination, CStr(result))
         
      '*** Clear all conditions
      Case 5
         Call delete_selection
            
      '*** Change year
      Case 6
         Call step_to_year(year)
            
      '*** Unknown command: ERROR
      Case Else
         status "DDE ERROR: Unknown command: " & txtDDE_in
         
   End Select
      
   '*** Store text to see if it really changes
   oldtxt = txtDDE_in.text
   
End Sub

'************************************************************************ '*** Sub set_global_condition() uses the frmGlobalSelection form to set '*** the selection indicated by variable, operator and value. '************************************************************************
Private Sub set_global_condition(variable As String, operator As String, _ value As String) frmGlobalSelection.CboVar = variable frmGlobalSelection.CboOp = operator frmGlobalSelection.TxtVal = value frmGlobalSelection.CmdSubmit_Click End Sub
'************************************************************************ '*** Sub delete_selection clears elements from the global selection '*** list if the elements has the specified variable name, operator and '*** value specified by the arguments. If no arguments are supplied the '*** entire list is cleared. '************************************************************************
Public Sub delete_selection(Optional variable As String, Optional operator As String, _ Optional value As String) '*** No arguments - clear all list If variable = "" And operator = "" And value = "" Then nSelItems = 0 ReDim SelLst(1) frmGlobalSelection.Text1 = Rnd '*** Tell frmglobalSelection to update... '*** Clear only elements given by arguments Else If nSelItems > 0 Then Dim i As Integer, newcount As Integer Dim found_match As Boolean Dim templist() As SelItem ReDim templist(nSelItems) '*** Load all elements not to be deleted to temporary list newcount = 1 found_match = False For i = 1 To nSelItems If SelLst(i).op = operator And SelLst(i).var = variable And _ SelLst(i).val = value Then found_match = True Else templist(newcount).op = SelLst(i).op templist(newcount).var = SelLst(i).var templist(newcount).val = SelLst(i).val newcount = newcount + 1 End If Next '*** If match found then rewrite the SelLst list If found_match = True Then For i = 1 To newcount - 1 SelLst(i) = templist(i) Next ReDim Preserve SelLst(1 To newcount - 1) nSelItems = newcount - 1 frmGlobalSelection.Text1 = Rnd '*** Tell frmglobalSelection to update... End If Else MsgBox "ERROR: trying to delete empy selection list" End If End If End Sub
'************************************************************************** '*** Sub check_DDEcommandtype() checks the type of DDE command that is '*** contained in command. It returns the separated command parameters and '*** the return code indicating the type of command. '*** Arguments: '*** command (IN): DDE command string sent from Excel '*** args (OUT): array of strings containing the command parameters '*** retcode (OUT): numbers 1 - 6 indicating type of command or error. '**************************************************************************
Private Sub check_DDEcommandtype(command As String, parameter() As String, _ retcode As Byte) Dim temp As String Dim i As Integer retcode = 0 '*** Separate the command parameter string For i = 1 To 7 parameter(i) = LCase(getword(command, i, "")) '*** The DDE adds two characters to the end of the string '*** CHECK THIS UP!!! If i = 7 Then temp = LCase(getword(command, i, "")) parameter(i) = Left(temp, Len(temp) - 2) End If Next '*** Analysis with no condition If parameter(1) <> "#" And parameter(2) <> "#" And parameter(3) <> "#" And _ parameter(4) <> "#" And parameter(5) = "#" And parameter(6) = "#" And _ parameter(7) = "#" Then _ retcode = 2 '*** Analysis with condition on the analysis variable If parameter(1) <> "#" And parameter(2) <> "#" And parameter(3) <> "#" And _ parameter(4) <> "#" And parameter(5) = "#" And parameter(6) <> "#" And _ parameter(7) <> "#" Then _ retcode = 3 '*** Analysis with condition on the selection variable If parameter(1) <> "#" And parameter(2) <> "#" And parameter(3) <> "#" And _ parameter(4) <> "#" And parameter(5) <> "#" And parameter(6) <> "#" And _ parameter(7) <> "#" Then _ retcode = 4 If parameter(1) = "!selection" Then '*** Clear If parameter(5) = "clear" Then retcode = 5 '*** Global condition If parameter(5) <> "#" And parameter(6) <> "#" And parameter(7) <> "#" Then _ retcode = 1 End If If parameter(1) = "[dummy]" And parameter(4) <> "#" Then retcode = 6 End Sub
'************************************************************************** '*** Function calculate_statistic(X, Y) returns the result of calculating '*** the statistic Y for variable X. '*** The result takes into account the global selections that are set by '*** frmGlobalSelection (the SelLst structure). '**************************************************************************
Private Function calculate_statistic(variable As String, statistic As String) _ As Double Dim vartype As String Dim sum As Double, minval As Double, maxval As Double, ssq As Double, DENOM As Double Dim n As Long, i As Long '*** Initialize the temporary vector Call prepare_temp(variable) vartype = Left(variable, 2) Select Case vartype '*** Individual variable Case "i_" Select Case UCase(statistic) Case "MEAN" sum = 0 For i = 1 To m_icount sum = sum + temp(i) * select_i(i) Next DENOM = CDbl(L_SUMVEC(select_i(1), m_icount)) If DENOM > 0 Then calculate_statistic = sum / DENOM Else calculate_statistic = 0 End If Case "SUM" sum = 0 For i = 1 To m_icount sum = sum + temp(i) * select_i(i) Next calculate_statistic = sum * m_weight Case "COUNT" calculate_statistic = L_SUMVEC(select_i(1), m_icount) * m_weight Case "MIN" minval = 1E+100 For i = 1 To m_icount If select_i(i) = 1 Then If temp(i) < minval Then minval = temp(i) End If Next calculate_statistic = minval Case "MAX" maxval = -1E+100 For i = 1 To m_icount If select_i(i) = 1 Then If temp(i) > maxval Then maxval = temp(i) End If Next calculate_statistic = maxval Case "STD" sum = 0 ssq = 0 n = 0 For i = 1 To m_icount sum = sum + temp(i) * select_i(i) ssq = ssq + temp(i) ^ 2 * select_i(i) n = n + select_i(i) Next DENOM = CDbl(n ^ 2 - n) calculate_statistic = Sqr((n * ssq - sum ^ 2) / DENOM) Case Else status "DDE ERROR: Unknown statistic: " & statistic End Select '*** Household variable Case "h_" Select Case UCase(statistic) Case "MEAN" sum = 0 For i = 1 To m_hcount sum = sum + temp(i) * select_h(i) Next DENOM = CDbl(L_SUMVEC(select_h(1), m_hcount)) If DENOM > 0 Then calculate_statistic = sum / DENOM Else calculate_statistic = 0 End If Case "SUM" sum = 0 For i = 1 To m_hcount sum = sum + temp(i) * select_h(i) Next calculate_statistic = sum * m_weight Case "COUNT" calculate_statistic = L_SUMVEC(select_h(1), m_hcount) * m_weight Case "MIN" minval = 1E+100 For i = 1 To m_hcount If select_h(i) = 1 Then If temp(i) < minval Then minval = temp(i) End If Next calculate_statistic = minval Case "MAX" maxval = -1E+100 For i = 1 To m_hcount If select_h(i) = 1 Then If temp(i) > maxval Then maxval = temp(i) End If Next calculate_statistic = maxval Case "STD" sum = 0 ssq = 0 n = 0 For i = 1 To m_hcount sum = sum + temp(i) * select_h(i) ssq = ssq + temp(i) ^ 2 * select_h(i) n = n + select_h(i) Next DENOM = CDbl(n * (n - 1)) calculate_statistic = Sqr((n * ssq - sum ^ 2) / DENOM) Case Else status "DDE ERROR: Unknown statistic: " & statistic End Select '*** Macro variable '*** NOTE: The actual macro value is reported, statistic is ignored Case "m_" calculate_statistic = get_macro_value(variable) Case Else status "DDE ERROR: Unknown variable type: " & variable End Select End Function
'**************************************************************************** '*** Sub send2excel() sends the string value, using DDE, to the Excel '*** worksheet cell specified by destination. '****************************************************************************
Private Sub send2excel(destination As String, value As String) '*** Topic: excel|sheet frmSESIMDDE.txtDDE_out.LinkTopic = "excel|" & getword(destination, 1, "_") '*** Manual link - has to be poked frmSESIMDDE.txtDDE_out.LinkMode = 2 '*** Item: cell frmSESIMDDE.txtDDE_out.LinkItem = getword(destination, 2, "_") frmSESIMDDE.txtDDE_out.text = value frmSESIMDDE.txtDDE_out.LinkPoke End Sub