16 Replies Latest reply on Sep 11, 2014 11:43 AM by HenlodeWaal

    Let's Share Useful Code Snippets!

      Hi Community,


      A lot of us have been looking for a good place to share and discuss different functions that we find helpful in day-to-day PI activity, and that's exactly what we are going to do here and now.  Please feel free to provide different functions that you often use below so we can discuss and learn from them.  Any coding language and applications are welcome; just provide us with the language the code is written in and a brief description of what it does/what you use it for.


      As a quick note, please do note request assistance troubleshooting code here as that is best handled by creating a new separate thread on the forum.


      I'll start by providing a few of my favorite ProcessBook VBA macros:


      Here is a short script that I use to iterate through every symbol in a ProcessBook display.  Usually I'll add an if statement so that I can sort by type.  I find this extremely helpful for passing along symbol changes.  For example, changing the time range on one trend automatically updating the time range on all other trends:


      Dim Sym as PbObjLib.Symbol 'create a variable for a generic symbol'
      For Each Sym in Application.ActiveDisplay.Symbols 'iterate through all symbols in display'
         If Sym.Type =  Then 'for the desired type use pbSYMBOLTYPE.pbSymbol for example a trend is pbSYMBOLTYPE.pbSymbolTrend'
            'insert code here'
         End If
      Next Sym


      This next one's a bit more complicated but I find it to be extremely valuable.  I have a trend symbol that I keep in the corner of my displays.  When I double-click on any bar or value symbol in my display the corner trend updates with an 8-hour trace of the bar or value symbol.  One of the very cool things about this code is that, because of how we resolve dataset names, we do not need any special handling to deal with symbols that use datasets.  This trend will update correctly no matter what we use:


      Private Sub Display_BeforeDoubleClick(bCancelDefault As Boolean, ByVal lvarX As Long, ByVal lvarY As Long)
      If ThisDisplay.Application.RunMode = True Then
          If SelectedSymbols.Count > 0 Then 'make sure we have actually double-clicked a symbol'
              If SelectedSymbols.Item(1).Type = pbSYMBOLTYPE.pbSymbolBar Or SelectedSymbols.Item(1).Type = pbSYMBOLTYPE.pbSymbolValue Then 'update trend for a bar or value symbol'
                  bCancelDefault = True
                  Trend1.RemoveTrace 1 'remove the existing trace'
                  Trend1.AddTrace SelectedSymbols.Item(1).GetTagName(1) 'add a trace using the tag or dataset from the selected symbol'
              End If
          End If
      End If
      End Sub


      I hope you find these scripts helpful and let me know if you'd like me to elaborate on any of the information provided here.


      Please comment on and like any particularly helpful functions you find here.  We are looking forward to seeing the awesome scripts you all have created!

        • Re: Let's Share Useful Code Snippets!

          That is a wonderfull idea DRabinowits!


          I have been using this code below, to activate any display. So the user may navigate through the display without seeing its toolbar:



          Private Sub Display_activate()
          '************* Working in a full screen mode ** ********************
              Application.FullScreen = True                                         '*   Mode Full Screen ON
              Dim i As Integer                                                               '*   
              Dim SL As Long                                                               '*   Scroll Lock
              SL = Me.Scroll(-10000, -10000)                                       '*   Inicial Position
              For i = 1 To Application.CommandBars.Count                 '*   Loop
                     Application.CommandBars.Item(i).Visible = False     '*   Hide all toolbars
              Next i                                                                                '*   
              Zoom = 120                                                                      '*   Zoom to 120% ---------------- These must be configured according your monitor size
          Call Your_Function                                                          '* Your Function
          End Sub
          • Re: Let's Share Useful Code Snippets!

            Here's a couple of snippets I use a lot. Update any number of Trends with a common start and end date. The code doesn't require that you know the names of the trends. It works by running through the list of symbols and if it is a trend then set its dates to the start and end date in the TextBoxes.


            1 ) Put 2 Microsoft Forms 2.0 TextBoxes on the Display page. Name one tbStartDate and the other tbEndDate.

            2 ) Put a Microsoft Forms 2.0 CommandButton on the Display page. Name it buUpdate.

            3 ) Paste the code below on the Display object VBA code window


            To use it, put a start and end date in the text boxes, then click the button.


            Also listed is a function to switch the mouse pointer from default to hourglass so the user knows if it's running a query or not.


            ' Example Code Below This point


            Option Explicit


            ' Code to paste onto the "ThisDisplay" Display Object
            ' Place two Microsoft Forms 2.0 TextBoxes on the Display page
            ' Name them as tbStartDate and tbEndDate
            ' Place a Microsoft Forms 2.0 CommandButton on the Display page
            ' Name it as buUpdate
            ' Paste the code below in the ThisDisplay VBA Code Display
            ' Lyle Mariam, aka The Flow Guy


            ' Button Click Event to trigger updating Trend Date Ranges


            Private Sub buUpdate_Click()
                Call UpdateTrendDates
            End Sub


            ' Function to change mouse pointer to hourglass and back to default
            ' HourGlass(Flag as Boolean)
            ' Useage: Call HourGlass(True)
            ' If Flag is true switch to hourglass else switch to default
            ' Lyle Mariam, aka The Flow Guy


            Public Sub HourGlass(Flag As Boolean)          'Show HourGlass
                If Flag Then


                    ThisDisplay.MousePointer = 11 ' vbHourglass
                    ThisDisplay.MousePointer = 0 ' vbDefault
                End If
            End Sub


            ' Function to update the Start and End Dates on a Display
            ' UpdateTrendDates()
            ' Useage: Call UpdateTrendDates
            ' Lyle Mariam, aka The Flow Guy


            Private Sub UpdateTrendDates()


                Dim StartDate As String
                Dim EndDate As String
                Dim TrendCnt As Integer
                Dim Ndx As Integer
                Dim xTrend As Trend
                Dim SymType As Long
                StartDate = ThisDisplay.tbStartDate.Value   ' Copy Start Date from Display TextBox to Local Variable
                EndDate = ThisDisplay.tbEndDate.Value       ' Copy End Date from Display TextBox to Local Variable
                Call HourGlass(True)                        ' Change mouse pointer to HourGlass
                TrendCnt = ThisDisplay.Symbols.Count        ' Find out how many symbols are on the display page
                ' Walk down the list of Symbols and if the Symbol is a Trend, Update the Start and End Date
                For Ndx = 1 To TrendCnt
                    SymType = ThisDisplay.Symbols.Item(Ndx).Type
                    If SymType = pbSYMBOLTYPE.pbSymbolTrend Then
                        Call ThisDisplay.Symbols.Item(Ndx).SetStartAndEndTime(StartDate, EndDate)
                    End If
                Call HourGlass(False)                       ' Switch back to default mouse pointer
            End Sub



            • Re: Let's Share Useful Code Snippets!

              ProcessBook - Zoom="FitAll" is not a "FixAll".


              From an old technical support call, I learned that not all displays are created equally, and that fitall will not always produce the desired results. The positions of symbols can cause undesirable effects, particularly topmost, leftmost symbol posistions, postions of whitespace, etc. The code below allows tweaking after the "FitAll". While not always required, often I have found that a small amount of "buffer" to frame the symbols provides a more asthetic appearance. The code is written in a format to more easily tweak and test, include and exclude some combinations of them... Sometimes they seem to work against one another. Your mileage may vary, but here is the snippet... enjoy.


              'For bonus points? You may be interested in the next 2 lines as well?
              Application.Maximize   ' see also .restore

              ThisDisplay.Zoom = "FitAll"


              'Get the display specs
              DsplyHght = ThisDisplay.ViewHeight
              DsplyWdth = ThisDisplay.ViewWidth
              DsplyLeft = ThisDisplay.ViewLeft
              DsplyTop = ThisDisplay.ViewTop

              'Adjustments for a buffer around the symbols
              lngAdjustDsplyLeft = -100 'buffer to the left

              lngAdjustDsplyTop = 100 'buffer at top
              lngAdjustWidth = 100 'buffer to the right
              lngAdjustHeight = 200 'buffer at bottom

              'Set the view here
              blnReturn = ThisDisplay.SetViewPort(DsplyTop + lngAdjustDsplyTop, DsplyLeft + lngAdjustDsplyLeft, DsplyHght + lngAdjustHeight, DsplyWdth + lngAdjustWidth)



              • Re: Let's Share Useful Code Snippets!

                MS Excel - Making your macros portable.



                The personal workbook (Personal.xlsb) is opened as a hidden workbook every time you start Excel. Macros stored there will be available to any open workbook. http://office.microsoft.com/en-us/excel-help/copy-your-macros-to-a-personal-macro-workbook-HA102174076.aspx


                Below are some reusable snippets:



                After using tag search, I use the following to transpose the tag list to columns (formatting for DataLink)


                Sub InsertBlankRows()

                ' select the cell at the top of a contiguous list, execute macro
                ' will transpose list on same row as activecell, starting one cell to the right


                 Dim rngMine As Range
                 Dim lngCount As Long

                'contiguous rows in a column - insert blank rows between the values - makes room for the timestamps to be included


                Set rngMine = Range(ActiveCell.Address, Range(ActiveCell.Address).End(xlDown))

                ' in a lot of macros, I find this very useful -> .End(xlDown) also> xlToRight, and to a lesser degree xlToLeft, xlUp
                    lngCount = rngMine.Rows.Count
                    Set rngMine = ActiveCell
                       For i = 1 To lngCount
                           ActiveCell.EntireRow.Insert Shift:=xlDown
                           ActiveCell.Offset(2, 0).Activate
                       Next i


                'continuation - move one cell to the right and transpose the list

                    Range(ActiveCell.Address, Range(ActiveCell.Offset((lngCount * 2) - 1, 0).Address)).Copy
                    Range(ActiveCell.Offset(0, 1).Address).PasteSpecial _
                End Sub




                Sub ConditionalHighlightCells()

                'Select a range of cells, then use the following code to highlight cells that contain a specified string


                Set rngMine = Selection

                For Each c In rngMine

                     'highlight the cell containing "error"
                    If InStr(1, c.Value, "error", vbTextCompare) Then 'I use InStr here (contains), but you can use c.value="error" for an exact match
                        With c.Interior
                            .Color = 65535 'yellow
                            'Another format that can be used
                            '.Color = RGB(200, 200, 255) ' RGB is Red, Green, Blue
                            .Pattern = xlSolid
                        End With
                    End If
                Next c


                 End Sub




                • Re: Let's Share Useful Code Snippets!

                  Using TypeLib Information (TLBINF32.dll)


                  This handy little dll is used by the Object Browser in VBE, but you can utilize it for your own purposes.


                  In the code below, I populate comboboxes with contants, extracted from a referenced dll (in the case below, pisdk.dll) . These are choices for the user, prior to executing the calculation routine.


                  The code is incomplete, for brevity, and this piecemealed, but it demonstrates use of the dll for your own purposes.


                  'Add references for TypeLib Information (TLBINF32.dll) and pisdk.dll
                  If TLApp Is Nothing Then
                      Set TLApp = New TLI.TLIApplication
                  End If
                  If TLInfo_pisdk Is Nothing Then
                      Set TLInfo_pisdk = TLApp.TypeLibInfoFromFile("c:\Program Files (x86)\Pipc\PISDK\pisdk.dll")
                  End If
                  '++++++++++++++ Code to populate combo for user selection
                  For Each ConstInfo In TLInfo_pisdk.Constants
                      If ConstInfo.Name = "ArchiveSummaryTypeConstants" Then
                         For Each MemInfo In ConstInfo.Members
                             cboSummaryType.AddItem (MemInfo.Name)
                             Debug.Print MemInfo.Name & vbTab & MemInfo.Value
                         Next MemInfo
                         'Exit For ' exit if this is the last IF
                      End If
                  Next ConstInfo
                  '++++++++++++++ separate event code... execution
                  'During execution, retrieve the actual values to be used in the method
                  For Each ConstInfo In TLInfo_pisdk.Constants
                     If ConstInfo.Name = "ArchiveSummaryTypeConstants" Then
                          For Each MemInfo In ConstInfo.Members
                             If MemInfo.Name = cboSummaryType.Value Then
                                  intConstSumVal = MemInfo.Value
                                  Exit For    'obtained the value, exit
                             End If
                         Next MemInfo
                         'Exit For ' exit if this is the last IF
                     End If
                  Next ConstInfo
                  'using intConstSumVal in the PIValues.Summary Method
                  Worksheets("FiltStats").Range("B12").Value = pvs.Summary(dt, dt2, intConstSumVal, intConstCalcVal)
                  'object.Summary StartTime, EndTime, SummaryType, CalculationBasis, AsyncStatus



                  Screenshot of the combo populated with the constants:



                  • Re: Let's Share Useful Code Snippets!

                    Sweet, thanks Richard. I expect nothing less from an fellow East Texas country boy, I was born and raised in Zavalla, we were almost neighbors!



                    • Re: Let's Share Useful Code Snippets!

                      Thanks again myDorazio for helping put this together.  Very useful concepts in this one.  


                      'This code synchronizes cursors on all trends on a display.



                      'at the top of thisdisplay object code (General Declarations)

                      Option Explicit
                      Dim WithEvents tndX As PBSymLib.Trend
                      ' in the display open dialog I had to make the use of the zoom function.  There is a problem adding a cursor to each trend with the following code that myDorazio helped me with.  It only places a cursor on objects that are 'visible on the display, with the exception that if I scroll around to view the object, the code then works adding a cursor to each trend even when they aren't visible on the display.  My work around is to zoom out then run 'the code to place the cursors then zoom back to 100%.  
                      'Later in thisdisplay object code
                      Private Sub Display_SelectionChange()
                      'If any of the selected symbols is a trend, then set tndX as a pointer to
                      'the symbol.
                      Dim smbX As PBObjLib.Symbol
                      For Each smbX In Application.ActiveDisplay.SelectedSymbols
                          If smbX.Type = pbSymbolTrend Then
                              Set tndX = smbX
                          End If
                      Next smbX
                      End Sub
                      Private Sub tndX_DropCursor(bCancel As Boolean, ByVal nCursor As Integer, ByVal NewTime As String)
                      'Inspect all of the symbols on the display and change the timespan
                      'of all the values.
                      Dim smbY As PBObjLib.Symbol
                      For Each smbY In Application.ActiveDisplay.Symbols
                          If smbY.Type = pbSYMBOLTYPE.pbSymbolTrend Then
                              'Make sure there is a cursor there to set time on...
                              If smbY.CursorCount < 1 Then
                              End If
                              smbY.CurrentCursor = 1
                              smbY.CursorTime = NewTime
                          End If
                      Next smbY
                      End Sub
                      • Re: Let's Share Useful Code Snippets!

                        Excel > User Defined Function


                        With Excel's extensive library of functions, I sometimes find it lacking. Below is an example of a UDF that saves me some headache over using the built-in Text to Columns (T2C). The headaches with T2C come when you modify the delimiter used in parsing, and later try to paste something of a different format (excel will remember that you used a comma to parse, and that was "back then", this is now, undo!). The function below is one that I use when I want to extract a piece of data from string that would be extracted with T2C:


                        In VBE, create a module (UDFs will not work if you have them in the module for a sheet).

                        Paste this code, then you can access the UDF by typing "=mySplitter(" then click the fx circled in red in the screenshot:

                        Then enter the cell, delimiter, and the position, hit


                        Public Function mySplitter(r As Range, strDelimiter As String, iPosition As Integer) As Variant
                             Dim strBuff As String
                             Dim ary
                             ary = Split(r.Value, strDelimiter, , vbTextCompare)
                             mySplitter = ary(iPosition)

                        End Function


                        A simple, but powerful example. UDF can be much more complex, the sky is the limit (err ugh your coding limit rather).
                        • Re: Let's Share Useful Code Snippets!

                          A note/caution on using Application.ActiveDisplay:


                          This will cause issues if that display loses focus to another Processbook display.  It might be better to use "me" in place of Application.ActiveDisplay

                          • Re: Let's Share Useful Code Snippets!

                            This little routine saved me hours of work


                            Replace existing multistate tagnames. in my case it was easy. replace 285 with 286


                            Sub test()

                            Dim mysymbol As Symbol
                            Dim mymultistate As MultiState

                            For Each Symbol In Symbols

                                If Symbol.IsMultiState = True Then
                                    Set mysymbol = Symbol
                                    Set mymultistate = mysymbol.GetMultiState
                                    If Left(mymultistate.GetPtTagName, 3) = 285 Then
                                        mymultistate.SetPtTagName ("286" & Mid(mymultistate.GetPtTagName, 4, 30))
                                    End If
                                End If

                            End Sub

                            • Re: Let's Share Useful Code Snippets!

                              There's a wide array of screen sizes and resolutions in use at our site, and we typically use processbook displays of fixed width (based on screen captures from our DCS... by the way OSIsoft, if you can come up with a clever way to import DeltaV screens into ProcessBook you'll save me hours! Failing that, maybe support png internally, as the files balloon to gigantic size when all these pictures are saved as 24bit bitmaps).


                              I call this script from the Display_Open method to adjust the zoom level according to screen width:

                              Declare Function GetSystemMetrics32 Lib "User32" _
                                  Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
                              Sub SetZoomLevel()
                              Dim width As Long
                              Dim Height As Long
                              width = GetSystemMetrics32(0)
                              Debug.Print width
                              Select Case width
                                  Case 1920
                                      ThisDisplay.Zoom = 100
                                  Case 1680
                                      ThisDisplay.Zoom = 100
                                  Case 1440
                                      ThisDisplay.Zoom = 82
                                  Case Else
                                      ThisDisplay.Zoom = 75
                              End Select
                              End Sub
                              • Re: Let's Share Useful Code Snippets!

                                Hello jbertin,


                                While I have no direct experience and can not vouch for the external product... google "Data South Grits". Grits is a graphics conversion utility made by a third party. Not sure of the pricing, but maybe you could talk to Santa about what you really want? I guess it comes down to how much time you spend manually recreating the graphics presently. I have no vested interest in this company, and you should do your due diligence before purchasing anything...


                                Also, not sure if you saw my post above on > ProcessBook - Zoom="FitAll" is not a "FixAll". Not sure if that code would be helpful to you or not...




                                • Re: Let's Share Useful Code Snippets!

                                  Have used GRITS, and while it isn't as simple as the sales material would lead you to believe, it is pretty great- and fairly inexpensive!

                                  • Re: Let's Share Useful Code Snippets!

                                    I will share a little code, but also have a question.


                                    Our PI graphics like our DCS graphic use "drill down" philosophy, where you end up with Layer 0 graphics (Area Overview), Layer 1 graphics (Units within the Areas), Layer 2 graphics (Subunit or Trains when redundant trains exist in a unit) and Layer 3 graphics (equipment within the subunits/trains).

                                    Typically the operators monitor the Overviews/Units - and drill down to lower levels as issues arrise.


                                    For storage of Displays we store them based upon their "Layers" (layer 0/1/2/3 etc)


                                    for navigation tools, by using MS Scripting - you can fill ActiveX combo boxes to read the contents in any one directory (or Subdirectory) to allow your user to navigate to the files


                                    Sub subLoadUnit()
                                    Dim i As Integer
                                    Dim j As Integer
                                    Dim fs, f, f1, fc, x, fsub, s, sFld
                                    Dim iFirst As Integer
                                    Dim iLast As Integer
                                    Dim sDirName(25) As String ' Used to capture the names of each of the sub directories in the Operating Area

                                    Dim iNoFiles As Integer
                                    Dim folderspec

                                    Dim sFilen As String
                                    Dim iNoSub As Integer
                                    Dim sTemp As String
                                    Dim sTemp1 As String
                                    Dim sTemp2 As String
                                    Dim iTemp As Integer
                                    Dim iMin As Integer
                                    Dim iMax As Integer
                                    Dim bNoExchanges As Boolean

                                    sRootDrive = "S:\PI\PI AV"

                                    ' We will HARD CODE the Area to Unit relationship

                                    ' Note in our case - we have Sequentially Numbered Units asigned to Areas


                                        Select Case ThisDisplay.cmbArea.Value
                                            Case "Mine"
                                                iMin = 0
                                                iMax = 28
                                            Case "PAL"
                                                iMin = 30
                                                iMax = 38
                                            Case "Refinery"
                                                iMin = 38
                                                iMax = 50
                                            Case "Utilities"
                                                iMin = 52
                                                iMax = 89
                                            Case Else
                                        End Select

                                    ' For the Unit Trends, they are stored in Units set up in PI AV
                                    '   We will read the directories - and group them based upon what the user
                                    '    has selected for the Area (PAL vs. Refinery etc)
                                    folderspec = sRootDrive
                                      iNoFiles = 0
                                      Set fs = CreateObject("Scripting.FileSystemObject")
                                            Set f = fs.GetFolder(folderspec)
                                            Set fc = f.SubFolders
                                             For Each f1 In fc
                                                sTemp = f1.Name
                                                If subIsNumber(sTemp) Then
                                                    iTemp = Left(sTemp, 2) * 1
                                                    Debug.Print iTemp
                                                    If iTemp > iMin And iTemp < iMax Then
                                                        iNoFiles = iNoFiles + 1
                                                        sDirName(iNoFiles) = sTemp
                                                        sSubDir(iNoFiles) = "\" & f1 & "\"
                                                    End If
                                                End If

                                    ' Unfortunately they are not in order (3100->3600 or 3900->4900 etc)
                                    ' So we will do a bubble sort on the array we created to put them in order
                                     ' Loop until no more "exchanges" are made.
                                                  bNoExchanges = True

                                                  ' Loop through each element in the array.
                                                  For i = 1 To iNoFiles - 1

                                                      ' If the element is greater than the element
                                                      ' following it, exchange the two elements.
                                                      If sDirName(i) > sDirName(i + 1) Then
                                                          bNoExchanges = False
                                                          sTemp1 = sDirName(i)
                                                          sTemp2 = sSubDir(i)
                                                          sDirName(i) = sDirName(i + 1)
                                                          sSubDir(i) = sSubDir(i + 1)
                                                          sDirName(i + 1) = sTemp1
                                                          sSubDir(i + 1) = sTemp1
                                                      End If
                                                  Next i
                                              Loop While Not (bNoExchanges)


                                    ' then we dump this to the combo box
                                    For i = 1 To iNoFiles
                                        With ThisDisplay.cmbUnit
                                            .AddItem sDirName(i)
                                        End With
                                    Next i

                                    ThisDisplay.cmbUnit.ListRows = iNoFiles

                                    End Sub




                                    NOW my question.... Typically in any MicroSoft File I can access file attributes with

                                    objFolder.GetDetailsOf(objFolderItem, i)


                                    For Processbooks - I can not seem to externally (VBA) access the Titles/Subject/Comments. I go to the properties and fill out the information -- but MS scripting does not show me the information I entered --> IS THERE ANOTHER WAY??????



                                    • Re: Let's Share Useful Code Snippets!

                                      I may be all wet here but if you speaking about the fields for Microsoft document files, then those fields may not exist for a ProcessBook file. Plus to add insult to injury, the format for Word and Excel (.docx and .xlsx) are different from the old .doc files and now are zipped XML files. To access the older file structures .doc/.xls then you can try using the DSOfile.dll to access/modify them.



                                      • Re: Let's Share Useful Code Snippets!

                                        I created a ERD display that change a 10+ SQC graphs, we use this to show the status of the BU->PLANT->KPI->PARAMETER


                                        So in the display file, we have a master SQC graph which will be the KPI for the selected BU->PLANT, when droping a cursor on the MASTER graph, all the other PARAMETER SQC graphs will also drop and cursor.


                                        NOTE: Master SQC trend must be renamed to "MASTER_SQCSymbol" & all the other SQC graphs must start with SQC, you can clear the cursor by clicking on the revert button.


                                        Private Sub MASTER_SQCSymbol_DropCursor(bCancel As Boolean, ByVal nCursor As Integer, ByVal NewTime As String)
                                        'GET CURSOR TIMESTAMPS FROM KPI MASTER
                                            Dim i As Integer
                                            For i = 1 To MASTER_SQCSymbol.Cursors.Count
                                                For Each Symbol In ThisDisplay.Symbols
                                                    If Left(Symbol.Name, 3) = "SQC" Then
                                                        Symbol.Cursors.Add (MASTER_SQCSymbol.Cursors.Item(i).Time)
                                                    End If
                                            Next i
                                        End Sub


                                        2014-09-11 13_41_17-PI ProcessBook - ERD_TEST.pdi_.jpg