Sorudan sonra sayfa kapanıyor!

[scadaman]

merhaba,
odbc ile veri tabanından sorgulama yapıyorum.yaptığım sorgulmayı excele rapor halinde yazdırmak istiyorum ancak macroyu çalştırdıktan sonra sorgulamayı yapıp değerleri excele aktarıyor ancak kaydetmeden sayfayı kendiliğinden kapatıyor.bu konuda yardıma ihtiyacım var.isteyen olursa kodu gönderebilirim.teşekkürler.

 

[Levent Menteşoğlu]

Kodu verirseniz daha aydınlatıcı olacaktır.

 

[scadaman]

sorgu kodu

sorguyu yaptıgım makro kodunu gönderiyorum.ilginize şimdiden teşekkürler.bu konuyla ilgili ancak sorguyu ADO ile yapan başka bir kodda mevcut elimde.ancak oda çalışmıyor.onu da en kısa sürede göndericem.


Sub Makro3()

With Selection.QueryTable
.Connection = _
"ODBC;DSN=S/3 SCADA Remote Historian;DBQ=.;SERVER=NotTheServer"
.CommandText = Array( _
"SELECT Averages.DATETIME, Averages.GRP, Averages.TAG, Averages.AVG_VALUE" & Chr(13) & "" & Chr(10) & "FROM Averages Averages" & Chr(13) & "" & Chr(10) & "WHERE (Averages.BEGIN={ts '2005-04-01 00:00:00'}) AND (Averages.GRP='p01') AND (Averages.TAG='ap') AND" _
, " (Averages.INTERVAL_SEC=3600) AND (Averages.NUMBER_OF=24)")
.Name="Query of S/3 SCADA Remote Historian "
.FieldNumbers=True
.RowNumbers=False
.FillAdjacentFormulas=False
.PreserveFormatting=True
.RefreshOnFileOpen=False
.BackgroundQuery=True
.RefreshStyle=xlInsertDeleteCells
.SavePassword=True
.SaveData=True
.AdjustColumnWidth=True
.RefreshPeriod=0
.PreserveColumnInfo=True
.Refresh BackgroundQuery:=False
End With

End Sub

 

[scadaman]

ADO ile yapılan sorgu

RS.Open satırıyla başlayan sorgu cümleciğinde syntax hatası veriyor.cümleciği birkaç kere değiştirip tekrar denedim ancak başaramadım.yardımlarınızı bekliyorum.hoşçakalın.


Sub Ara()
Dim CN As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim I As Integer
Dim RefCol As Integer
Dim Grp As Integer
Dim Tag As Integer
Dim Grps(1 To 2) As String
Dim Tags(1 To 12) As String
Dim TarihYazildi As Boolean
Dim DosyaAdi As String

'Değişik grup ve tagleri doldur.
Grps(1) = "RTU"
Grps(2) = "ALAVARDI"
Tags(1) = "seviye1"
Tags(2) = "seviye2"
Tags(3) = "seviye3"
Tags(4) = "seviye4"
Tags(5) = "debi1"
Tags(6) = "debi2"
Tags(7) = "tdebi1"
Tags(8) = "tdebi2"
Tags(9) = "adebi"
Tags(10) = "atdebi"
Tags(11) = "basinc1"
Tags(12) = "basinc2"
CN.ConnectionString = "DSN=S/3 Scada Local Historian"
CN.CursorLocation = adUseClient
CN.Open

Sheet1.Range("A2", "O50").Clear
RefCol = 1
TarihYazildi = False
Cells(2, 1) = "Saat"
'Worksheets("Sheet1").Range("A3:O26").BorderAround ColorIndex:=1, Weight:=xlThick
Sheet1.Range("A1:O27").Borders(xlInsideHorizontal).Weight = xlThick
Sheet1.Range("A226").Borders(xlInsideVertical).Weight = xlThick
'Her grup için dön.
For Grp = 1 To UBound(Grps)
For Tag = 1 To UBound(Tags)
DoEvents
'Bu grup ve seviye için 24 günlük değeri getir.
RS.Open "select avg_value,datetime from averages where GRP='" & Grps(Grp) & "' AND TAG='" & Tags(Tag) & "'" & _
" and INTERVAL_SEC=3600 AND BEGIN={ts '" & Format(Cells(1, 2), "YYYY-MM-DD") & " 08:00:00'} AND NUMBER_OF=24", CN If Not RS.EOF Then
If Not TarihYazildi Then
'Tarih yazılmadığı için bir kereliğine yaz.
While Not RS.EOF
Cells(RS.AbsolutePosition + 2, RefCol) = RS.Fields("datetime") & ""
RS.MoveNext
Wend
TarihYazildi = True
RefCol = RefCol + 1
RS.MoveFirst
End If
Cells(2, RefCol) = Grps(Grp) & "," & Tags(Tag)
While Not RS.EOF
Cells(RS.AbsolutePosition + 2, RefCol) = RS.Fields("avg_value") & ""
RS.MoveNext
Wend
End If
RS.Close
RefCol = RefCol + 1
Next Tag
Next Grp
'Yazıcıdan çıktısını al.
On Error Resume Next
If Format(Time, "hh:mm") = "08:00" Then
Sheet1.PrintOut
End If
End Sub