VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CExcelInsert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
#Const VersionDebug = 0
Private m_strRet As String
Private m_StartRow As Long
Private m_StartCol As Long
Private m_blnByCol As Boolean
Private m_RecLength As Long
Private m_ws As Excel.Worksheet
Private m_GType As String
Private m_GPosition As String
Private m_GPercentComplete As Integer
Private lTracker As Long
Private mcount As Integer

Dim blnFirstUpdate As Boolean
Dim cUpdate As Excel.Chart
Dim ELognum As Integer
Dim PLognum As Integer



Public Sub ChartFlag(p As String)
   Dim position As Integer
       #If VersionDebug Then
            position = 10
            WriteProcLog "ChartFlag", position, "ChartFlag procedure called with " & p & " as parameter value."
       #End If
       
   Select Case p
      Case "FIRST"
         Call InsertChart
         Call UpdateChart
      Case "UPDATE"
         Call UpdateChart
   End Select

End Sub
Private Sub OpenLogFiles()
   Dim ELogPath As String
   Dim PLogPath As String
   
   #If VersionDebug Then
   
   On Error GoTo OpenLogFileERR
       PLognum = FreeFile
       PLogPath = App.Path & "\EInsertProc.log"
      Open PLogPath For Append As #PLognum
       
   ELognum = FreeFile
   ELogPath = App.Path & "\EInsertERR.log"
   Open ELogPath For Append As #ELognum
   
   
   Exit Sub
OpenLogFileERR:
   Close
   #End If
   
End Sub

Private Sub CloseLogFiles()
   #If VersionDebug Then
       Close #ELognum
       Close #PLognum
   #End If
   
End Sub
Private Sub WriteProcLog(pName As String, position As Integer, sExamine As String)
 
   Dim sTimestamp As String
   Dim s1 As String
   
    #If VersionDebug Then
  
        On Error GoTo WriteProcLogERR
        sTimestamp = Format(Now, "General Date")
        s1 = sTimestamp & ";" & pName & "; Position: " & Str$(position) & "; " & sExamine
        Print #PLognum, s1
        Exit Sub
WriteProcLogERR:
  
  Call WriteErrorLog("WriteProcLog")
  
  #End If
  
End Sub
Private Sub WriteErrorLog(pName As String, Optional sExamine As String)
   Dim fnum As Integer
   Dim sPath As String
   Dim sTimestamp As String
   Dim s1 As String
   
#If VersionDebug Then
   
    On Error GoTo WriteELOGERR
   
    sTimestamp = Format(Now, "General Date")
    
    If Not IsMissing(sExamine) Then
       s1 = pName & ", " & sTimestamp & ", Error: " & Err.Number & " " & Err.Description & ", " & sExamine
    Else
       s1 = pName & ", " & sTimestamp & ", Error: " & Err.Number & " " & Err.Description
    End If
       
    Print #ELognum, s1
    
    Exit Sub
WriteELOGERR:
    CloseLogFiles
    Exit Sub
    
#End If
   
End Sub
Private Sub InsertChart()
    
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim cs As Chart
    Dim cos As ChartObjects
    Dim co As ChartObject
    Dim c As Chart
    Dim position As Integer
    
    On Error GoTo InsertChartERR
    
                    #If VersionDebug Then
                         position = 10
                         WriteProcLog "InsertChart", position, "InsertChart procedure called. " & m_ws.Name
                    #End If
    
    If m_GPosition = "NEWSHEET" Then
       Set wb = m_ws.Application.ActiveWorkbook
                    #If VersionDebug Then
                         position = 11
                         WriteProcLog "InsertChart", position, wb.Name
                    #End If
       Set cs = wb.Charts.Add
                     #If VersionDebug Then
                         position = 20
                         WriteProcLog "InsertChart", 20, "Name: " & cs.Name & "; Parent:" & cs.Parent.Name
                    #End If
       cs.ChartType = xlLine 'Stacked
                     #If VersionDebug Then
                         position = 30
                         WriteProcLog "InsertChart", position, "ChartType assignment"
                     #End If
       
       cs.Move After:=wb.Worksheets(wb.Worksheets.Count)
       cs.Name = "TekChart" & wb.Charts.Count
       Set cUpdate = cs
       
                    #If VersionDebug Then
                         position = 30
                         WriteProcLog "InsertChart", position, "Name: " & cs.Name & "; Parent:" & cs.Parent.Name
                    #End If
       
    Else
       Set ws = m_ws
       Set cos = ws.ChartObjects
       Set co = cos.Add(Left:=20, Top:=50, Width:=375, Height:=225)
       Set c = co.Chart
       c.ChartType = xlLine 'Stacked
       Set cUpdate = c
       
            #If VersionDebug Then
                 position = 40
                 WriteProcLog "InsertChart", position, "Name: " & c.Name & "; Parent:" & c.Parent.Name
            #End If
       
    End If
    
    Exit Sub
InsertChartERR:
    Call WriteErrorLog("InsertChart", Str$(position))

End Sub

  Private Sub UpdateChart()
       
       On Error GoTo UpdateChartErr
       Dim r As Excel.Range
       Dim position As Integer
       
       #If VersionDebug Then
             position = 10
             WriteProcLog "UpdateChart", position, "UpdateChart procedure called."
      #End If
       
       Select Case m_GType
           Case "NONE"
               Exit Sub
           Case "COMPLETION", "PERIODIC"
              If m_blnByCol Then
                    Set r = m_ws.Range(m_ws.Cells(m_StartRow, m_StartCol), m_ws.Cells(m_StartRow + lTracker, m_StartCol + (mcount - 1)))
                    
                    #If VersionDebug Then
                         position = 20
                         WriteProcLog "UpdateChart", position, "Address of r: " & r.Address
                    #End If
                    
                    With cUpdate
                       .SetSourceData Source:=r, PlotBy:=Excel.xlColumns
                        
                               #If VersionDebug Then
                                     position = 40
                                     WriteProcLog "UpdateChart", position, "SetSourceData assignment"
                               #End If
                        .HasTitle = True
                               #If VersionDebug Then
                                     position = 50
                                     WriteProcLog "UpdateChart", position, "HasTitle assignment"
                               #End If
                        
                        .ChartTitle.Characters.Text = Format$(Now, "mmm/dd/yy") & " - (" & Format(Now, "hh:nn:ss AM/PM") & ")"
                        .HasAxis(xlCategory, xlPrimary) = True
                        .HasAxis(xlValue, xlPrimary) = True
                        .HasLegend = True
                     End With
             Else   ' user selected by row data display
                    
                    Set r = m_ws.Range(m_ws.Cells(m_StartRow, m_StartCol), m_ws.Cells(m_StartRow + (mcount - 1), m_StartCol + lTracker))
                    
                    #If VersionDebug Then
                         position = 60
                         WriteProcLog "UpdateChart", position, "Address of r: " & r.Address
                    #End If
                    
                    With cUpdate
                       .SetSourceData Source:=r, PlotBy:=Excel.xlRows
                        
                               #If VersionDebug Then
                                     position = 60
                                     WriteProcLog "UpdateChart", position, "SetSourceData assignment"
                               #End If
                        .HasTitle = True
                               #If VersionDebug Then
                                     position = 70
                                     WriteProcLog "UpdateChart", position, "HasTitle assignment"
                               #End If
                        
                        .ChartTitle.Characters.Text = Format$(Now, "mmm/dd/yy") & " - (" & Format(Now, "hh:nn:ss AM/PM") & ")"
                        .HasAxis(xlCategory, xlPrimary) = True
                        .HasAxis(xlValue, xlPrimary) = True
                        .HasLegend = True
                     End With
              End If
          
       
       End Select
  
  Exit Sub
UpdateChartErr:
     Call WriteErrorLog("UpdateChart", Str$(position))
  End Sub

Public Property Get strRet() As String
   strRet = m_strRet

End Property

Public Property Let strRet(ByVal sNewValue As String)
 
  Dim arrHold
  Dim hold As String
  Dim i As Integer
  Dim nsize As Integer
  Dim position As Integer
  
  On Error GoTo strRetERR
  m_strRet = sNewValue
  
  #If VersionDebug Then
    position = 10
    WriteProcLog "Let strRet", position, m_strRet
  #End If
  
  If InStr(m_strRet, ";") <> 0 Then
      arrHold = Split(m_strRet, ";")
      lTracker = lTracker + 1
      m_ws.Application.ScreenUpdating = False
      mcount = (UBound(arrHold) - LBound(arrHold)) + 1
      
      #If VersionDebug Then
            position = 20
            WriteProcLog "Let strRet", position, "Mcount: " & Str$(mcount)
      #End If
      
      For i = LBound(arrHold) To UBound(arrHold)
          hold = arrHold(i)
          If m_blnByCol Then
               m_ws.Cells(lTracker + m_StartRow, m_StartCol + i).Value = CTekDbl(hold) 'CDbl(arrHold(i))
              
          Else
               m_ws.Cells(m_StartRow + i, m_StartCol + lTracker).Value = CTekDbl(hold) 'CDbl(arrHold(i))
              
          End If
      Next
      m_ws.Application.ScreenUpdating = True
  Else
     
     mcount = 1
     
     lTracker = lTracker + 1
     
     If m_blnByCol Then
         m_ws.Cells(lTracker + m_StartRow, m_StartCol).Value = CTekDbl(m_strRet) 'CDbl(m_strRet)
         
     Else
         m_ws.Cells(m_StartRow, m_StartCol + lTracker).Value = CTekDbl(m_strRet) 'CDbl(m_strRet)
        
     End If
   
  End If

        ' accomodate running out of columns
  If Not m_blnByCol Then
     nsize = UBound(arrHold) - LBound(arrHold) + 1
     If lTracker + m_StartCol > 255 Then
         m_StartRow = m_StartRow + nsize + 2
         lTracker = 1
     End If
  End If
  
  Exit Property
strRetERR:
  Call WriteErrorLog("Let strRet", sNewValue)
  
End Property

Public Sub Configure(ws As Excel.Worksheet, StartRow As Long, StartCol As Long, ByCol As Boolean, _
                     Optional GraphType As String, Optional GraphPosition As String, Optional GraphPercentComplete As Integer)
                     
  On Error GoTo ConfigErr
   Dim position As Integer
    
    
    
         
        Set m_ws = ws
        
         #If VersionDebug Then
            position = 10
            WriteProcLog "Configure", position, ws.Name & "; StartRow: " & StartRow & _
                      "; StartCol: " & StartCol & "; ByCol: " & ByCol & "; Graphtype: " & GraphType & _
                      "; GraphPosition: " & GraphPosition & "; GraphPercentComplete: " & GraphPercentComplete
         #End If
          
        m_StartRow = StartRow
        m_StartCol = StartCol
        m_blnByCol = ByCol
 
     
     If Not IsMissing(GraphType) Then
        m_GType = GraphType
     Else
       m_GType = "NONE"
     End If
     
     If Not IsMissing(GraphPosition) Then
        m_GPosition = GraphPosition
     Else
        m_GPosition = "NEWSHEET"
     End If
     
     If Not IsMissing(GraphPercentComplete) And GraphPercentComplete <> 0 Then
         m_GType = "PERIODIC"
         m_GPercentComplete = GraphPercentComplete
     Else
         m_GPercentComplete = 0
     End If
     
     lTracker = 0
     
     #If VersionDebug Then
            position = 20
            WriteProcLog "Configure", position, ws.Name & "; StartRow: " & StartRow & _
                      "; StartCol: " & StartCol & "; ByCol: " & ByCol & "; Graphtype: " & GraphType & _
                      "; GraphPosition: " & GraphPosition & "; GraphPercentComplete: " & GraphPercentComplete
     #End If
   
 Exit Sub
ConfigErr:
  Call WriteErrorLog("Configure")
End Sub

Private Sub Class_Initialize()
   lTracker = 0
   m_blnByCol = True
   m_GType = "NONE"
   m_GPosition = "NEWSHEET"
   m_GPercentComplete = 0
  Call OpenLogFiles
End Sub

Public Property Get GType() As String
    GType = m_GType
End Property

Public Property Get GPosition() As String
   GPosition = m_GPosition
End Property

Private Sub Class_Terminate()
 Dim position As Integer
       #If VersionDebug Then
            position = 10
            WriteProcLog "ClassTerminate", position, "ClassTerminate procedure called"
       #End If

 Call CloseLogFiles
End Sub

Public Function CTekDbl(Source As String) As Double
    Dim NegFlag As Boolean
    Dim IntPart As Double
    Dim DecPart As Double
    Dim Exponent As Integer
    Dim DecMult As Double
    Dim RetVal As Double
    Dim i As Integer
    Dim StringLength As Integer
    Dim StringSave As String
    
    StringSave = Source
    NegFlag = False
    IntPart = 0#
    DecPart = 0#
    Exponent = 0#
    DecMult = 1#
    RetVal = 0#
    i = 0
    Trim (Source)
    StringLength = Len(Source)
    If ("-" = Left$(Source, 1)) Then
        NegFlag = True
        Source = Mid(Source, 2)
    Else
        If ("+" = Left$(Source, 1)) Then
            Source = Mid(Source, 2)
        End If
    End If
    StringLength = Len(Source)
    Do
        If (0 <> StringLength) And (IsNumeric(Left$(Source, 1))) Then
            IntPart = (IntPart * 10#) + CDbl(Left$(Source, 1))
            Source = Mid(Source, 2)
            StringLength = Len(Source)
        Else
            StringLength = 0
        End If
    Loop While 0 <> StringLength
    StringLength = Len(Source)
    If ((0 < StringLength) And ("." = Left$(Source, 1))) Then
        Source = Mid(Source, 2)
        StringLength = Len(Source)
        Do
            If (0 <> StringLength) And (IsNumeric(Left$(Source, 1))) Then
                DecMult = DecMult * 0.1
                DecPart = DecPart + (DecMult * CDbl(Left$(Source, 1)))
                Source = Mid(Source, 2)
                StringLength = Len(Source)
            Else
                StringLength = 0
            End If
        Loop While 0 <> StringLength
    End If
    StringLength = Len(Source)
    If ((0 < StringLength) And (("E" = Left$(Source, 1)) Or ("e" = Left$(Source, 1)))) Then
        Source = Mid(Source, 2)
        Exponent = Fix(Source)
    End If
    RetVal = (IntPart + DecPart) * (10# ^ Exponent)
    CTekDbl = IIf(NegFlag, -RetVal, RetVal)
    Source = StringSave
End Function

