Вывод 3-х минутных значений

Dim UserName As String
Dim UserPswd As String
Dim sqlserver As String
Dim curdate As String
Dim idvti As Integer
Dim ofs As Integer
Dim isexistlim As Boolean
Dim timeout As Integer
 
Public Sub GetHourEng()
  Dim str As String
  Dim oRes
  Dim oConn
  Dim oCmd
  Dim rndval As Long
  Dim index_x As Integer
  Dim index_y As Integer
  Dim dt1 As String
  Dim dt2 As String
  Dim i As Integer
  
  DecimalSeparator = "."
  
  Randomize Timer
  rndval = CLng(Rnd * 10000) + 50000
  
  ofs = 8
  isexistlim = True
      
  idvti = getidvti(fmMain.CBVti.List(fmMain.CBVti.ListIndex))
    
  ClearHourEng
  
' Ñîçäàåì îáúåêòû
  Set oConn = CreateObject("ADODB.Connection")
  Set oRes = CreateObject("ADODB.Recordset")
  Set oRs = CreateObject("ADODB.Recordset")
  Set oCmd = CreateObject("ADODB.Command")
    
  sqlserver = LoadParams(1)
  UserName = LoadParams(2)
  UserPswd = LoadParams(3)
  timeout = LoadParams(4)
    
' Ôîðìèðóåì ñòðîêó ñîåäèíåíèÿ
  s = "Provider=SQLOLEDB.1;Password=" & UserPswd & ";Persist Security Info=True;User ID=" & UserName & ";Initial Catalog=e6work;Data Source=" + sqlserver + ";Connect Timeout=" + CStr(timeout)
  oConn.Open s
    
  s = "select v.idvti, v.vtishrname, v.vtiusernumber, u.unitshrrusname  from e6pr.pr_vtilist v, e6pr.pr_dictunitslist u where v.outunit=u.idunit and idvti=" + CStr(idvti)
  oRs.Open s, oConn
  If Not oRs.EOF Then
    
    If fmMain.EdDate.Value <> "01.01.2001" Then
      curdate = Format(CDate(fmMain.EdDate.Value), "dd.mm.yyyy")
    Else
      curdate = Date
    End If
    
    Sheets("Ïîòðåáëåíèå").Cells(2, 2) = CStr(Date) + " " + CStr(Time)
    Sheets("Ïîòðåáëåíèå").Cells(3, 2) = "Òàáëèöà ÷àñîâîãî ïîòðåáëåíèÿ çà ñóòêè (" + curdate + ")"
    Sheets("Ïîòðåáëåíèå").Cells(4, 2) = "Êàíàë    " + oRs.Fields("vtishrname").Value
    Sheets("Ïîòðåáëåíèå").Cells(7, 5) = oRs.Fields("unitshrrusname").Value
    Sheets("Ïîòðåáëåíèå").Cells(7, 6) = oRs.Fields("unitshrrusname").Value
    Sheets("Ïîòðåáëåíèå").Cells(7, 7) = oRs.Fields("unitshrrusname").Value
    
    dt1 = Format(curdate, "dd.mm.yyyy") + " 00:00:00"
    dt2 = Format(CDate(curdate) + 1, "dd.mm.yyyy") + " 00:00:00"
  
    str = "exec ep_askvtidata @cmd=list, @idvti=" + CStr(idvti) + ", @timestart='" + dt1 + "', @timeend='" + dt2 + "'"
    str = str + ", @idreq=" + CStr(rndval)
    oCmd.ActiveConnection = oConn
    oCmd.CommandText = str
    oCmd.Execute
    
    str = "select idvti, valuefl, timertc, timesql, datepart(minute,timesql) as hh from vtidatalist where idreq=" + CStr(rndval) + " and idvti=" + CStr(idvti) + " order by timertc"
    oRes.Open str, oConn
    If Not oRes.EOF Then
      Do While Not oRes.EOF
        index_x = GetIndex_x_h(oRes.Fields("idvti").Value)  ' êîîðäèíàòà õ (ñòîëáåö)
        index_y = GetIndex_y_h(oRes.Fields("hh").Value)     ' êîîðäèíàòà y (ñòðîêà)
        Sheets("Ïîòðåáëåíèå").Cells(index_y, index_x) = oRes.Fields("ValueFl").Value
        oRes.MoveNext
      Loop
    End If
  
    GetLimStation     ' âûâîäèì ëèìèò
    End If
End Sub
 
 
Private Sub GetLimStation()
  Dim s As String
  Dim i As Integer
  Dim index_x As Integer
  Dim index_y As Integer
  Dim oRes
  Dim oConn
  Dim ind As Integer
  
  Set oConn = CreateObject("ADODB.Connection")
  Set oRes = CreateObject("ADODB.Recordset")
  
' Ôîðìèðóåì ñòðîêó ñîåäèíåíèÿ
  s = "Provider=SQLOLEDB.1;Password=" & UserPswd & ";Persist Security Info=True;User ID=" & UserName & ";Initial Catalog=e6work;Data Source=" + sqlserver + ";Connect Timeout=" + CStr(timeout)
  oConn.Open s
  
  s = "select * from DispGrafic where flg=1 and idvti=" + CStr(idvti) + " and AskedDate='" + curdate + "'"
  oRes.Open s, oConn
  If Not oRes.EOF Then
'    Sheets("Èñõîäíûå äàííûå").Select
    Do While Not oRes.EOF
      index_x = GetIndex_x_h(oRes.Fields("idvti").Value) - 1  ' êîîðäèíàòà õ (ñòîëáåö)
      For i = 0 To 23
        If ((Format(Date, "dd.mm.yyyy") = curdate) And (Hour(Time) <= i)) Then Exit For
        index_y = i + ofs
        Sheets("Ïîòðåáëåíèå").Cells(index_y, index_x) = oRes.Fields("lim" + CStr(i + 1)).Value
      Next
      oRes.MoveNext
    Loop
  Else
    MsgBox "Äëÿ êàíàëà íå çàäàí ëèìèòíûé ïëàí!"
    isexistlim = False
  End If
 
End Sub
 
Private Function GetIndex_x_h(id As Long)
  GetIndex_x_h = 6
End Function
 
Private Function GetIndex_y_h(h As Integer)
  If h = 0 Then h = 24
  GetIndex_y_h = h + ofs - 1
End Function
 
Public Function getidvti(s)
  Dim ind As Integer
  Dim str As String
  
  str = Left(s, Len(s) - 1)
  ind = InStr(1, str, "(")
  str = Right(str, Len(str) - ind)
  
  getidvti = CLng(str)
End Function