VERSION 5.00
Begin VB.Form zsesimDDE 
   Caption         =   "sesimDDE"
   ClientHeight    =   4770
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5730
   LinkMode        =   1  'Source
   LinkTopic       =   "sesimDDE"
   MDIChild        =   -1  'True
   ScaleHeight     =   4770
   ScaleWidth      =   5730
   WindowState     =   1  'Minimized
   Begin VB.TextBox Text2 
      Height          =   345
      Left            =   300
      LinkItem        =   "R1C2"
      LinkTopic       =   "excel|sesim"
      TabIndex        =   2
      Text            =   $"edmodDDE.frx":0000
      Top             =   540
      Width           =   3975
   End
   Begin VB.ListBox List1 
      Height          =   1815
      Left            =   300
      TabIndex        =   1
      Top             =   1560
      Width           =   3975
   End
   Begin VB.TextBox Text1 
      Height          =   345
      Left            =   300
      LinkItem        =   "Text1"
      TabIndex        =   0
      Top             =   60
      Width           =   3975
   End
End
Attribute VB_Name = "zsesimDDE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************
' This module is serving the Excel report generator

' Syntax på ingående kommandosträng
' åtskilda med tecknet ¤
' 1-4 är nödvändiga, 5-7 optional
' 1. Resultatvariabel
' 2. Destination i Excel (format r1c1)
' 3. Statistika
' 4. År
' 5. Selekteringsvariabel
' 6. Selekteringsoperator
' 7. Selekteringsvärde

Option Explicit
Dim result As Variant
Dim selection_vector() As Integer
Dim selection_active As Integer


Private Sub Text1_Change()
  Dim txt1 As String, txt2 As String
  Dim i As Integer, sun_delim As Integer
  
  If Text1.text = "" Then Exit Sub

  If Left$(Text1.text, 3) = "End" Then Text1.text = ""

  ' Manuellt läge
  If Left$(Text1.text, 1) = "_" Then Exit Sub

  If init_done = 0 Then Call Initsesim

  ' Selection
  If Left$(Text1.text, 1) = "!" Then
    Call set_selection(Text1.text)
    Exit Sub
  End If
    
  If Text1.text = "" Then Exit Sub
  
  txt1 = Text1.text
  
  ' look for delimiter
  sun_delim = InStr(1, txt1, "¤")
  If sun_delim = 0 Then
    Exit Sub
  End If
  
  ' Exit if variable does not exist
  If getword(txt1, 1, "¤") <> "[dummy]" Then
    If lookup_var(getword(txt1, 1, "¤")) = False Then Exit Sub
  End If

  txt2 = ""
  For i = 1 To Len(txt1)
    If Asc(Mid$(txt1, i, 1)) < 32 Then Exit For
    txt2 = txt2 & Mid$(txt1, i, 1)
  Next
  
  If txt2 = "" Then Exit Sub
    
  Call compute(txt2)

  Text1.text = ""
  
'  If List1.ListCount > 0 Then
'    Dim txt3 As String
'    txt3 = List1.List(0)
'    List1.RemoveItem 0
'    Text1.text = txt3
'  End If
  
End Sub

Sub compute(txt) Dim j As Integer, exc_year As Integer, comp_case As Integer, opcase As Integer Dim sum As Double, mean As Double, opvalnum As Double Dim statistika As String Dim countvalue As Long, countfreq As Long, i As Long, n As Long, nn As Long Dim var1 As String, var2 As String, op As String, opval As String Dim par(1 To 7) As String '*** Separate the command parameters For i = 1 To 7 par(i) = LCase(getword(txt, i, "¤")) Next '*** If no return position is given then exit If par(2) = "" Then MsgBox "Error in Excel return location" Exit Sub End If '*** Make sure that the linktopix is OK before setting the mode If par(2) = "#" Then '*** The temporary sheet "temp" always exists Text2.LinkTopic = "excel|temp" Else Text2.LinkTopic = "excel|" & getword(par(2), 1, "_") End If Text2.LinkMode = 2 statistika = par(3) '*** Statistic exc_year = par(4) '*** Current year of analysis If Not IsNumeric(exc_year) Then MsgBox "Error in year" Exit Sub End If var1 = par(1) '*** Analysis variable var2 = par(5) '*** Selection variable op = par(6) '*** Selection operator opval = par(7) '*** Selection value '*** Goto year If exc_year <> base_year + model_time Then If binary_files_exist(exc_year - base_year) = True Then status "Change to time" & CStr(exc_year - base_year) Call read_data(exc_year - base_year) controlcenter.antalindivider.Caption = m_icount controlcenter.antalhushåll.Caption = m_hcount Call controlcenter.update_viewers status "Done" Else If exc_year > base_year + model_time Then i = exc_year - (base_year + model_time) controlcenter.comb1Yearstorun.text = CStr(i) & " year" controlcenter.cmd1run_Click Else status "Restart is needed - no saved files" Call Initsesim i = exc_year - (base_year + model_time) controlcenter.comb1Yearstorun.text = CStr(i) & " year" controlcenter.cmd1run_Click End If End If End If '*** If the analysis variable is set to [dummy] then exit after having '*** changed the year. If var1 = "[dummy]" Then Exit Sub ' Exit if the user pressed stop If exc_year <> base_year + model_time Then Exit Sub End If ' If macro variable If Mid$(var1, 1, 1) = "m" Then Text2.LinkItem = par(2) If statistika = "sum99" Then result = get_macro_value(var1) * m_price99 Else result = get_macro_value(var1) End If '*** Write the result back to Excel and then exit the sub Text2.text = result Text2.LinkPoke Exit Sub End If If Mid$(var1, 1, 1) = "i" Then n = m_icount If Mid$(var1, 1, 1) = "h" Then n = m_hcount If n = 0 Then MsgBox "Error in variable name: " & var1 Exit Sub End If '*** If there exists a selection variable If var2 <> "#" Then Call prepare_temp(var2) For i = 1 To n temp2(i) = temp(i) Next End If '*** Prepare the analysis variable. Call prepare_temp(var1) '*** No conditions comp_case = 1 '*** Conditions on the analysis variable If var2 = "#" And op <> "#" And opval <> "#" And IsNumeric(opval) Then opcase = 0 Select Case op Case "gt" opcase = 1 Case "ge" opcase = 2 Case "lt" opcase = 3 Case "le" opcase = 4 Case "ne" opcase = 5 Case "eq" opcase = 6 End Select If opcase > 0 Then comp_case = 2 End If '*** Conditions on the selection variable If var2 <> "#" And op <> "#" And opval <> "#" And IsNumeric(opval) Then opcase = 0 Select Case op Case "gt" opcase = 1 Case "ge" opcase = 2 Case "lt" opcase = 3 Case "le" opcase = 4 Case "ne" opcase = 5 Case "eq" opcase = 6 End Select If opcase > 0 Then comp_case = 3 End If Dim nsel As Double Dim dummy As Integer Select Case comp_case '*** No conditions Case 1 Select Case statistika Case "mean", "mean99", "sum", "sum99" sum = 0 mean = 0 nsel = 0 If selection_active = 0 Then For i = 1 To n sum = sum + temp(i) nsel = nsel + 1 Next If nsel > 0 Then mean = sum / nsel Else For i = 1 To n sum = sum + temp(i) * selection_vector(i) nsel = nsel + selection_vector(i) Next 'If n > 0 Then mean = sum / n If nsel > 0 Then mean = sum / nsel End If Case "count" countfreq = 0 countvalue = 0 If selection_active = 0 Then For i = 1 To n If CLng(temp(i)) > countvalue Then countfreq = countfreq + 1 Next Else For i = 1 To n If CLng(temp(i)) > countvalue Then countfreq = countfreq + selection_vector(i) Next End If End Select '*** Conditions on the analysis variable Case 2 opvalnum = CVar(opval) If selection_active = 0 Then dummy = 1 Select Case statistika Case "mean", "mean99", "sum", "sum99" sum = 0 mean = 0 nn = 0 For i = 1 To n If selection_active = 1 Then dummy = 0 If selection_vector(i) = 1 Then dummy = 1 End If Select Case opcase Case 1 If temp(i) > opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 2 If temp(i) >= opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 3 If temp(i) < opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 4 If temp(i) <= opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 5 If temp(i) <> opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 6 If temp(i) = opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If End Select Next If nn > 0 Then mean = sum / nn Case "count" countfreq = 0 For i = 1 To n If selection_active = 1 Then dummy = 0 If selection_vector(i) = 1 Then dummy = 1 End If Select Case opcase Case 1 If temp(i) > opvalnum Then countfreq = countfreq + 1 * dummy Case 2 If temp(i) >= opvalnum Then countfreq = countfreq + 1 * dummy Case 3 If temp(i) < opvalnum Then countfreq = countfreq + 1 * dummy Case 4 If temp(i) <= opvalnum Then countfreq = countfreq + 1 * dummy Case 5 If temp(i) <> opvalnum Then countfreq = countfreq + 1 * dummy Case 6 If temp(i) = opvalnum Then countfreq = countfreq + 1 * dummy End Select Next End Select '*** Conditions on the selection variable Case 3 opvalnum = CVar(opval) If selection_active = 0 Then dummy = 1 Select Case statistika Case "mean", "mean99", "sum", "sum99" sum = 0 mean = 0 nn = 0 For i = 1 To n If selection_active = 1 Then dummy = 0 If selection_vector(i) = 1 Then dummy = 1 End If Select Case opcase Case 1 If temp2(i) > opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 2 If temp2(i) >= opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 3 If temp2(i) < opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 4 If temp2(i) <= opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 5 If temp2(i) <> opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If Case 6 If temp2(i) = opvalnum Then sum = sum + temp(i) * dummy nn = nn + 1 * dummy End If End Select Next If nn > 0 Then mean = sum / nn Case "count" countfreq = 0 For i = 1 To n If selection_active = 1 Then dummy = 0 If selection_vector(i) = 1 Then dummy = 1 End If Select Case opcase Case 1 If temp2(i) > opvalnum Then countfreq = countfreq + 1 * dummy Case 2 If temp2(i) >= opvalnum Then countfreq = countfreq + 1 * dummy Case 3 If temp2(i) < opvalnum Then countfreq = countfreq + 1 * dummy Case 4 If temp2(i) <= opvalnum Then countfreq = countfreq + 1 * dummy Case 5 If temp2(i) <> opvalnum Then countfreq = countfreq + 1 * dummy Case 6 If temp2(i) = opvalnum Then countfreq = countfreq + 1 * dummy End Select Next End Select End Select Select Case statistika Case "mean" result = mean Case "mean99" result = mean * m_price99 Case "sum" result = sum * m_weight Case "sum99" result = sum * m_weight * m_price99 Case "count" result = countfreq * m_weight End Select '*** Write the results back to Excel Text2.LinkItem = getword(par(2), 2, "_") Text2.text = result Text2.LinkPoke End Sub
Function lookup_var(txt) As Boolean Dim c lookup_var = False For Each c In var_coll If c = txt Then lookup_var = True Exit Function End If Next For Each c In mvar_coll If c = txt Then lookup_var = True Exit Function End If Next End Function
Private Sub set_selection(txt) Dim var As String, op As String, opvaltxt As String Dim opcase As Integer, first_selection As Integer Dim opval As Double, n As Double Dim i As Long var = getword(txt, 5, "¤") op = getword(txt, 6, "¤") opvaltxt = getword(txt, 7, "¤") If IsNumeric(opvaltxt) Then opval = opvaltxt '*** Instruktion to clear selection If var = "clear" Then selection_active = 0 Erase selection_vector Exit Sub End If '*** Exit if variable does not exist If lookup_var(var) = False Then Exit Sub '*** Exit if not i-variable If Left$(var, 1) <> "i" Then Exit Sub If Left$(var, 1) = "i" Then n = m_icount If Left$(var, 1) = "h" Then n = m_hcount If selection_active = 0 Then ReDim selection_vector(1 To n) first_selection = 1 End If Call prepare_temp(var) Select Case op Case "gt" opcase = 1 Case "ge" opcase = 2 Case "lt" opcase = 3 Case "le" opcase = 4 Case "ne" opcase = 5 Case "eq" opcase = 6 End Select Dim dummy As Integer For i = 1 To n dummy = 0 Select Case opcase Case 1 If temp(i) > opval Then dummy = 1 Case 2 If temp(i) >= opval Then dummy = 1 Case 3 If temp(i) < opval Then dummy = 1 Case 4 If temp(i) <= opval Then dummy = 1 Case 5 If temp(i) <> opval Then dummy = 1 Case 6 If temp(i) = opval Then dummy = 1 End Select If first_selection = 1 Then selection_vector(i) = dummy Else selection_vector(i) = selection_vector(i) * dummy End If Next If Left$(var, 1) = "i" Then selection_active = 1 End Sub