Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Scribd
Upload
126 views

VBA Code

This document contains code for several VBA subroutines that perform operations on HMI graphics files such as: 1. Printing screen captures of HMI graphics files to a text file while modifying properties like background color and object positions. 2. Finding tag names referenced in HMI graphic properties and writing them to a CSV file. 3. Replacing tag names referenced in HMI graphic properties with new names and writing the changes to a CSV file. 4. Selecting objects in HMI graphics that contain a given text string. 5. Modifying properties of objects like colors and deleting unnecessary objects before printing screen captures.

Uploaded by

Manan Maheshwari
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
126 views

VBA Code

This document contains code for several VBA subroutines that perform operations on HMI graphics files such as: 1. Printing screen captures of HMI graphics files to a text file while modifying properties like background color and object positions. 2. Finding tag names referenced in HMI graphic properties and writing them to a CSV file. 3. Replacing tag names referenced in HMI graphic properties with new names and writing the changes to a CSV file. 4. Selecting objects in HMI graphics that contain a given text string. 5. Modifying properties of objects like colors and deleting unnecessary objects before printing screen captures.

Uploaded by

Manan Maheshwari
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 5

Sub PrintScreens()

Dim FSO As New FileSystemObject


Dim Folder As Folder
Dim File As File
Dim Doc As Document
Dim Obj As HMIObject
Dim objView As HMIView
Dim TS As TextStream
Set Folder = FSO.GetFolder(grafexe.ApplicationDataPath)
Set TS = FSO.OpenTextFile("D:\SMR Graphics List.txt", ForWriting, True)
For Each File In Folder.Files
If Not Left(File.Name, 1) = "@" And LCase(Right(File.Name, 4)) = ".pdl"
Then
Set Doc = grafexe.Documents.Open(File.Path)
TS.WriteLine Doc.Name
Doc.Width = 1280
Doc.Height = 845
Doc.Properties("BackColor") = 15066597
For Each Obj In Doc.HMIObjects
If Not Obj.Type = "HMIGroup" Then
Obj.Top = Obj.Top + 20
End If
Next
Set Obj = Doc.HMIObjects.AddHMIObject("TitleBar", "HMIStaticText")
Obj.Left = 0
Obj.Top = 0
Obj.Width = 1280
Obj.Height = 20
Obj.Properties("Text") = " " & File.Name
Doc.Grid = False
Obj.Properties("FontBold") = True
Set objView = ActiveDocument.Views(1)
objView.PrintDocument
Doc.Close
End If
Next
End Sub
Sub FindTag()
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim File As File
Dim Doc As Document
Dim Obj As HMIObject
Dim Prop As HMIProperty
Dim VarName As String
Dim VarToFind As String
Dim TS As TextStream
Dim Source As TextStream
Dim VarsToFind() As String
Set Source = FSO.OpenTextFile("D:\TagsToFind.txt", ForReading, True)
Set Folder = FSO.GetFolder(grafexe.ApplicationDataPath)
Set TS = FSO.OpenTextFile("D:\TagsFound.csv", ForWriting, True)
Counter = 0
While Not Source.AtEndOfStream
TextLine = Source.ReadLine
If Len(TextLine) > 0 Then

Counter = Counter + 1
ReDim Preserve VarsToFind(Counter) As String
VarsToFind(Counter) = TextLine
End If
Wend
Source.Close
For Each File In Folder.Files
If Not Left(File.Name, 1) = "@" And LCase(Right(File.Name, 4)) = ".pdl"
Then
Set Doc = grafexe.Documents.Open(File.Path)
For Each Obj In Doc.HMIObjects
For Each Prop In Obj.Properties
If Prop.DynamicStateType = hmiDynamicStateTypeVariableDirect
Then
VarName = Prop.Dynamic.VarName
For Counter = 1 To UBound(VarsToFind)
If VarsToFind(Counter) = VarName Then
TS.WriteLine File.Name & "," & Obj.ObjectName &
"," & Prop.Name & "," & VarName
End If
Next
End If
Next
Next
Doc.Close
End If
Next
TS.Close
End Sub
Sub ReplaceTag()
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim File As File
Dim Doc As Document
Dim Obj As HMIObject
Dim Prop As HMIProperty
Dim VarName As String
Dim VarToFind As String
Dim TS As TextStream
Dim Source As TextStream
Dim VarsToFind() As String
Dim ReplaceWith() As String
Set Source = FSO.OpenTextFile("D:\TagsToReplace.txt", ForReading, True)
Set Folder = FSO.GetFolder(grafexe.ApplicationDataPath)
Set TS = FSO.OpenTextFile("D:\TagsReplaced.csv", ForWriting, True)
Counter = 0
While Not Source.AtEndOfStream
TextLine = Source.ReadLine
If Len(TextLine) > 0 Then
Counter = Counter + 1
ReDim Preserve VarsToFind(Counter) As String
ReDim Preserve ReplaceWith(Counter) As String
VarsToFind(Counter) = Split(TextLine, ",")(0)
ReplaceWith(Counter) = Split(TextLine, ",")(1)
End If
Wend

Source.Close
For Each File In Folder.Files
If Not Left(File.Name, 1) = "@" And LCase(Right(File.Name, 4)) = ".pdl"
Then
Set Doc = grafexe.Documents.Open(File.Path)
DocChanged = False
For Each Obj In Doc.HMIObjects
For Each Prop In Obj.Properties
If Prop.DynamicStateType = hmiDynamicStateTypeVariableDirect
Then
VarName = Prop.Dynamic.VarName
For Counter = 1 To UBound(VarsToFind)
If VarsToFind(Counter) = VarName Then
Prop.Dynamic.VarName = ReplaceWith(Counter)
DocChanged = True
TS.WriteLine File.Name & "," & Obj.ObjectName &
"," & Prop.Name & "," & VarName & " replaced with " & ReplaceWith(Counter)
End If
Next
End If
Next
Next
If DocChanged Then
Doc.Save
End If
Doc.Close
End If
Next
TS.Close
End Sub
Sub FindText()
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim File As File
Dim Doc As Document
Dim Obj As HMIObject
Dim Prop As HMIProperty
Dim TextToFind As String
Set Folder = FSO.GetFolder(grafexe.ApplicationDataPath)
TextToFind = "gain"
For Each File In Folder.Files
If Not Left(File.Name, 1) = "@" And LCase(Right(File.Name, 4)) = ".pdl"
Then
Set Doc = grafexe.Documents.Open(File.Path)
For Each Obj In Doc.HMIObjects
If Not Obj.Type = "HMIActiveXControl" Then
For Each Prop In Obj.Properties
If InStr(1, LCase(Prop.value), LCase(TextToFind)) > 0 Th
en
Obj.Selected = True
Obj.Selected = False
End If
Next
End If
Next
Doc.Close

End If
Next
End Sub
Sub PrintScreens()
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim File As File
Dim Doc As Document
Dim Obj As HMIObject
Dim objView As HMIView
Dim TS As TextStream
Dim colSearchResults As HMICollection
Dim objStaticText As HMIStaticText
Set Folder = FSO.GetFolder(grafexe.ApplicationDataPath)
Set TS = FSO.OpenTextFile("D:\SMR Graphics List.txt", ForWriting, True)
For Each File In Folder.Files
If Not Left(File.Name, 1) = "@" And LCase(Right(File.Name, 4)) = ".pdl"
Then
Set Doc = grafexe.Documents.Open(File.Path)
TS.WriteLine Doc.Name
'Doc.Width = 1280
'Doc.Height = 845
Set colSearchResults = ActiveDocument.HMIObjects.Find(ObjectType:="H
MIRectangle")
For Each Obj In colSearchResults
If Obj.Properties("BackColor") = RGB(0, 0, 0) Then
Obj.Delete
End If
Next
Set colSearchResults = ActiveDocument.HMIObjects.Find(ObjectType:="H
MIButton")
For Each Obj In colSearchResults
If Obj.Properties("Text") = "Close" Then
Obj.Delete
End If
Next
Set colSearchResults = ActiveDocument.HMIObjects.Find(ObjectType:="H
MIStaticText")
For Each Obj In colSearchResults
If Obj.Properties("ForeColor") = RGB(255, 191, 255) Then
Obj.Properties("ForeColor") = RGB(255, 255, 255)
End If
Next
Set objStaticText = ActiveDocument.HMIObjects.AddHMIObject("Static_T
ext1", "HMIStaticText")
With objStaticText
.Text = "Close"
.AdaptBorder = False
.Height = 30
.Width = 159
.Top = 723
.Left = 684

.BackColor = RGB(218, 218, 218)


.GlobalColorScheme = False
.AlignmentLeft = 1
.AlignmentTop = 1
.FONTSIZE = 17
End With
Doc.Properties("BackColor") = RGB(145, 145, 145)
For Each Obj In Doc.HMIObjects
If Not Obj.Type = "HMIGroup" Then
Obj.Top = Obj.Top + 20
End If
Next
Set Obj = Doc.HMIObjects.AddHMIObject("TitleBar", "HMIStaticText")
Obj.Left = 0
Obj.Top = 0
Obj.Width = 1280
Obj.Height = 20
Obj.Properties("Text") = " " & File.Name
Doc.Grid = False
Obj.Properties("FontBold") = True
Set objView = ActiveDocument.Views(1)
objView.PrintDocument
Doc.Close
End If
Next
End Sub

You might also like