12/9/2014 11:07 AM | |
Posts: 107 Rating: (0) |
Hello All... advice/help please have a code wich is working fine with my project (exporting several tags wincc to excel) I'm getting tag values and want to draw a borders (doesn't matter Used cells or all over the sheet) tell me please how can I enable Borders to be On in VBA .. where I have to write it? something like this (example for Excel) Sub Private() With ActiveSheet.UsedRange.Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub NEED borders in the code below ______________________\\\\\\\\ WinCC VBA code////////__________________________________ Sub OnClick(ByVal Item) Dim sDsn, sCon, sSql Dim conn, oRs, oCom Dim m, DSNName,ServerName, sServerName Dim objControl Dim sBeginTime, sEndTime Dim sGMTime,sLocalTime Dim TimeCorrection Dim sFileName Dim sTagName Dim i,j,R,C,Diff Dim bVisible Dim bTimeCollumn Dim OldLocale Dim Ans objExcelApp.Visible = True Set ExcelSheet = CreateObject("Excel.Sheet") ExcelSheet.Application.Visible = True ExcelSheet.ActiveSheet.Name = "ExportVal" HMIRuntime.Trace vbCrLf & "DSN: " & sDsn & vbCrLf sDsn = "Catalog=" & sDsn & ";" sCon = "Provider=WinCCOLEDBProvider.1;" & sDsn & "Data Source=" & sServerName &"\WinCC" Set conn = CreateObject("ADODB.Connection") conn.ConnectionString = sCon HMIRuntime.Trace "ADO DB conection string: " & conn.ConnectionString & vbCrLf conn.CursorLocation = 3 conn.Open Set oRs = CreateObject("ADODB.Recordset") Set oCom = CreateObject("ADODB.Command") Set objControl = ScreenItems("Adonet") C = 2 bTimeCollumn = False For i = 0 To objControl.NumItems - 1 objControl.Index = i bVisible = objControl.ItemVisible HMIRuntime.Trace "№: " & i & " ; " & bVisible & vbCrLf If bVisible Then C = C + 1 sTagName = objControl.TagName ExcelSheet.ActiveSheet.Cells(2,C).Value = objControl.Name ExcelSheet.ActiveSheet.Cells(2,C).Font.Color = objControl.Color ExcelSheet.ActiveSheet.Cells(2,C).Font.Size = 10 ExcelSheet.ActiveSheet.Cells(2,C).Font.Bold = True ExcelSheet.ActiveSheet.Cells(2,C).Interior.ColorIndex = 15 End If HMIRuntime.Trace "T2: " & sBeginTime & " --- " & sEndTime & vbCrLf sSql = "Tag:R,'" & sTagName & "','" & Year(sBeginTime) &"-" & Month(sBeginTime) & "-" & Day(sBeginTime) & " " & Hour(sBeginTime) & ":" & Minute(sBeginTime) & ":" & Second(sBeginTime) & ".000', '" & Year(sEndTime) & "-" & Month(sEndTime) & "-" & Day(sEndTime) & " " & Hour(sEndTime) & ":" & Minute(sEndTime) & ":" & Second(sEndTime) & ".000'" HMIRuntime.Trace "SQL string: " & sSql & vbCrLf oCom.CommandType = 1 Set oCom.ActiveConnection = conn oCom.CommandText = sSql Set oRs = oCom.Execute m = oRs.Fields.Count HMIRuntime.Trace "Arch: " & oRs.Fields.Count & " - " & oRs.RecordCount & vbCrLf If(m>0) Then oRs.MoveFirst R = 2 Do While Not oRs.EOF R = R + 1 ExcelSheet.ActiveSheet.Cells(R,C).Value = oRs.Fields(2).Value If Not bTimeCollumn Then ExcelSheet.ActiveSheet.Cells(R,2).Value = CStr(DateAdd("h", TimeCorrection, oRs.Fields(1).Value)) ExcelSheet.ActiveSheet.Cells(R,1).Value = R - 2 Else End If oRs.MoveNext Loop Else End If Next HMIRuntime.Trace "Control1: stop" & vbCrLf ExcelSheet.ActiveSheet.Cells(1,1).Value = R - 2 ExcelSheet.ActiveSheet.Cells(1,2).Value = C - 2 Set oRs = Nothing Set conn = Nothing ExcelSheet.ActiveSheet.Columns(1).Font.Bold = True ExcelSheet.ActiveSheet.Rows(1).Font.Bold = True ExcelSheet.ActiveSheet.Rows(1).Font.Italic = True ExcelSheet.ActiveSheet.Rows(1).Font.Underline = True ExcelSheet.ActiveSheet.Columns.AutoFit sFileName = "C:\Documents and Settings ExcelSheet.SaveAs sFileName MsgBox "Отчет сохранен в файле:" & vbCrLf & sFileName ScreenItems("Report").Text = sFileName ExcelSheet.Application.Quit Set ExcelSheet = Nothing objExcelApp.Quit Set objExcelApp = Nothing SetLocale(OldLocale) End Sub thanks IT_Service --------------- New subject after splitting from WinCC RT can not start and migrated project have no Alarms. |
Last edited by: Min_Moderator at: 12/9/2014 12:08 PMSplitted |
|
12/10/2014 6:57 AM | |
Joined: 2/21/2014 Last visit: 8/13/2024 Posts: 652 Rating: (348) |
Hi It Service, .LineStyle = 1 |
You can always use "Rate" and "To Thank" button to appreciate my efforts in helping you :) |
|
12/10/2014 9:01 AM | |
Posts: 107 Rating: (0) |
HI and Thanks but it's not working. have a look link you gave regards IT_Service
|
12/10/2014 11:28 AM | |
Joined: 2/21/2014 Last visit: 8/13/2024 Posts: 652 Rating: (348) |
Do you mean link is not working ? or the code? I tried with the code and it's working. and also the link is working. I attach the code I tried (by minimizing your code) and alsothe result. you can choose your range or/and play around according to your requirement. I hope this is what you are looking for. If it does not work, let us know where exactly it is not working in code. Attachmenttest.zip (168 Downloads) |
Last edited by: Min_Moderator at: 12/10/2014 11:39 AMChange name of attachment Last edited by: HarrY ji at: 12/10/2014 11:29 AMor you mean something else? You can always use "Rate" and "To Thank" button to appreciate my efforts in helping you :) |
|
12/18/2014 8:14 AM | |
Posts: 107 Rating: (0) |
Sorry for the late response thanks regards IT_Service
Attachmentexport.zip (153 Downloads) |
Follow us on