universe design tool (unv universe) toplu obje güncelleme (bulk object update) – 2

Önceki yazıda paylaşılan kodun performansı iyileştirilmiştir. Ayrıca toplu obje gizleme işlemi sonucunda boş kalan klasörleri de belirleyip gizleme yapmaktadır.


Option Explicit 'require variables to be declared before being used
Dim DesignerApp As Designer.Application
Dim Univ As Designer.Universe
Dim Cls As Designer.Class
Dim Obj As Designer.Object
Dim Pdc As Designer.PredefinedCondition
Dim Wksht As Excel.Worksheet
Dim Ssttrr As String
Dim Rn As Integer
Dim WorksheetRowCount As Integer
Dim StatusChangeFlag As Boolean
Dim CheckList(1 To 20000, 1 To 2) As String
Dim DeepHideList(1 To 20000, 1 To 6) As String
' 1:Level, 2:ObjectType, 3:ObjectName, 4:ObjectStatus, 5:ParentClass, 6:HideFlag
Dim DeepHideIndex As Integer
Dim DeepHideLevel As Integer
Dim WkshtDoc As Excel.Worksheet
Dim WkshtRes As Excel.Worksheet



' başlangıç metodu
Sub GetData()
   
    Set DesignerApp = New Designer.Application
    DesignerApp.Visible = True
    Call DesignerApp.LogonDialog
    Set Univ = DesignerApp.Universes.Open
    'Set Univ = DesignerApp.Universes.Import("/deneme_klasor", "deneme_unv")
   
    'DesignerApp.Visible = False
   
    Set Wksht = ThisWorkbook.Worksheets("Objects")
    'Wksht.Unprotect
   
    WorksheetRowCount = Wksht.UsedRange.Rows.Count
    'Rn = 0
   
    For Rn = 1 To WorksheetRowCount
        CheckList(Rn, 1) = Wksht.Cells(Rn, 1).Value
        CheckList(Rn, 2) = Wksht.Cells(Rn, 2).Value
    Next Rn
   
    Call GoClasses(Univ.Classes)
   
    DeepHideIndex = 1
    DeepHideLevel = 0
    Call DocumentDeepHideList(Univ.Classes, 0, DeepHideIndex, "Root")
   
    Set WkshtDoc = ThisWorkbook.Worksheets("Doc")
    For Rn = 1 To (DeepHideIndex - 1)
        If (DeepHideLevel < CInt(DeepHideList(Rn, 1))) Then
            DeepHideLevel = CInt(DeepHideList(Rn, 1))
        End If
        WkshtDoc.Cells(Rn, 1).Value = DeepHideList(Rn, 1)
        WkshtDoc.Cells(Rn, 2).Value = DeepHideList(Rn, 2)
        WkshtDoc.Cells(Rn, 3).Value = DeepHideList(Rn, 3)
        WkshtDoc.Cells(Rn, 4).Value = DeepHideList(Rn, 4)
        WkshtDoc.Cells(Rn, 5).Value = DeepHideList(Rn, 5)
        WkshtDoc.Cells(Rn, 6).Value = DeepHideList(Rn, 6)
    Next Rn
    WkshtDoc.Cells(Rn + 1, 1).Value = "Max Lvl"
    WkshtDoc.Cells(Rn + 1, 2).Value = CStr(DeepHideLevel)
   
    Call CalculateDeepHide(1)
   
    Set WkshtRes = ThisWorkbook.Worksheets("Res")
    For Rn = 1 To (DeepHideIndex - 1)
        WkshtRes.Cells(Rn, 1).Value = DeepHideList(Rn, 1)
        WkshtRes.Cells(Rn, 2).Value = DeepHideList(Rn, 2)
        WkshtRes.Cells(Rn, 3).Value = DeepHideList(Rn, 3)
        WkshtRes.Cells(Rn, 4).Value = DeepHideList(Rn, 4)
        WkshtRes.Cells(Rn, 5).Value = DeepHideList(Rn, 5)
        WkshtRes.Cells(Rn, 6).Value = DeepHideList(Rn, 6)
    Next Rn
    WkshtRes.Cells(Rn + 1, 1).Value = "Max Lvl"
    WkshtRes.Cells(Rn + 1, 2).Value = CStr(DeepHideLevel)
   
    Call FolderDeepHide(Univ.Classes)
   
    'WkshtRes.Protect
    'WkshtDoc.Protect
    'Wksht.Protect
   
End Sub



' excel listesindeki objeler, klasör ve objeler üzerinde özyinelemeli olarak gezilerek görünürlükleri devre dışı bırakılıyor
Sub GoClasses(Clss)
   
    Dim TempClsName As String
    Dim TempObjName As String
    Dim TempPdcName As String
   
    For Each Cls In Clss
        TempClsName = Cls.Name
        For Each Obj In Cls.Objects
            TempObjName = Obj.Name
            'Rn = Rn + 1
            'Wksht.Cells(Rn, 1).Value = Cls.Name
            'Wksht.Cells(Rn, 2).Value = Obj.Name
            StatusChangeFlag = False
            For Rn = 1 To WorksheetRowCount
                If (TempClsName = CheckList(Rn, 1)) And (TempObjName = CheckList(Rn, 2)) Then
                    StatusChangeFlag = True
                    Wksht.Cells(Rn, 3).Value = "done"
                End If
            Next Rn
            If (StatusChangeFlag = True) And (Obj.Show = True) Then
                Obj.Show = False
                Obj.Description = Obj.Description & " #hide_unused_object_201709#"
            End If
        Next Obj
        For Each Pdc In Cls.PredefinedConditions
            TempPdcName = Pdc.Name
            'Rn = Rn + 1
            'Wksht.Cells(Rn, 1).Value = Cls.Name
            'Wksht.Cells(Rn, 2).Value = Obj.Name
            StatusChangeFlag = False
            For Rn = 1 To WorksheetRowCount
                If (TempClsName = CheckList(Rn, 1)) And (TempPdcName = CheckList(Rn, 2)) Then
                    StatusChangeFlag = True
                    Wksht.Cells(Rn, 3).Value = "done"
                End If
            Next Rn
            If (StatusChangeFlag = True) And (Pdc.Show = True) Then
                Pdc.Show = False
                Pdc.Description = Pdc.Description & " #hide_unused_object_201709#"
            End If
        Next Pdc
       
        If Cls.Classes.Count > 0 Then
            Call GoClasses(Cls.Classes)
        End If
       
    Next Cls
   
End Sub



' ilgili excel verisine göre obje gizleme işinden sonra boş klasörleri tespit etmek için obje ve klasör envanteri çıkarılıyor
Sub DocumentDeepHideList(Clss, Lvl, DeepHideIndex, DeepHideParentClassName)
   
    Dim TempClsName As String
    Dim TempObjName As String
    Dim TempPdcName As String
   
    For Each Cls In Clss
        If (Cls.Show = True) Then
            TempClsName = Cls.Name
           
            DeepHideList(DeepHideIndex, 1) = CStr(Lvl)
            DeepHideList(DeepHideIndex, 2) = "Class"
            DeepHideList(DeepHideIndex, 3) = TempClsName
            DeepHideList(DeepHideIndex, 4) = "True" ' object status
            DeepHideList(DeepHideIndex, 5) = DeepHideParentClassName ' parent class
            DeepHideList(DeepHideIndex, 6) = "False"
            DeepHideIndex = DeepHideIndex + 1 ' hide flag
           
            For Each Obj In Cls.Objects
                If (Obj.Show = True) Then
                    DeepHideList(DeepHideIndex, 1) = CStr(Lvl + 1)
                    DeepHideList(DeepHideIndex, 2) = "Object"
                    DeepHideList(DeepHideIndex, 3) = Obj.Name
                    DeepHideList(DeepHideIndex, 4) = "True" ' object status
                    'If (Obj.Show = True) Then
                    '    DeepHideList(DeepHideIndex, 4) = "True"
                    'Else
                    '    DeepHideList(DeepHideIndex, 4) = "False"
                    'End If
                    DeepHideList(DeepHideIndex, 5) = TempClsName ' parent class
                    DeepHideList(DeepHideIndex, 6) = "False" ' hide flag
                    DeepHideIndex = DeepHideIndex + 1
                End If
            Next Obj
            For Each Pdc In Cls.PredefinedConditions
                If (Pdc.Show = True) Then
                    DeepHideList(DeepHideIndex, 1) = CStr(Lvl + 1)
                    DeepHideList(DeepHideIndex, 2) = "Filter"
                    DeepHideList(DeepHideIndex, 3) = Pdc.Name
                    DeepHideList(DeepHideIndex, 4) = "True" ' object status
                    DeepHideList(DeepHideIndex, 5) = TempClsName ' parent class
                    DeepHideList(DeepHideIndex, 6) = "False" ' hide flag
                    DeepHideIndex = DeepHideIndex + 1
                End If
            Next Pdc
           
        End If
       
        If Cls.Classes.Count > 0 Then
            Call DocumentDeepHideList(Cls.Classes, Lvl + 1, DeepHideIndex, TempClsName)
        End If
       
    Next Cls
   
End Sub



' en derin seviyeden en üst seviyeye doğru tümseviyelerde alt seviyesinde görünür obje olup olmadığına göre hesaplama yapılıyor
Sub CalculateDeepHide(abc)
    Dim DeepHideLevel_i As Integer
    Dim DeepHide_i As Integer
    Dim change_i As Integer
    Dim DeepHide_ii As Integer
   
    For DeepHideLevel_i = DeepHideLevel To 0 Step -1
        ' MsgBox "" & DeepHideLevel_i
        For DeepHide_i = 1 To (DeepHideIndex - 1)
            If (DeepHideList(DeepHide_i, 2) = "Class") And (DeepHideLevel_i = DeepHideList(DeepHide_i, 1)) Then
                change_i = 0
                For DeepHide_ii = 1 To (DeepHideIndex - 1)
                    If ((DeepHide_i <> DeepHide_ii) And (CStr(CInt(DeepHideList(DeepHide_i, 1)) + 1) = DeepHideList(DeepHide_ii, 1)) And (DeepHideList(DeepHide_i, 3) = DeepHideList(DeepHide_ii, 5)) And (DeepHideList(DeepHide_ii, 4) = "True")) Then
                        change_i = 1
                        Exit For ' DeepHide_ii = (DeepHideIndex - 1) ' Exit For
                    End If
                Next DeepHide_ii
                If (change_i = 0) Then
                    DeepHideList(DeepHide_i, 4) = "False" ' object status
                    DeepHideList(DeepHide_i, 6) = "True" ' hide flag
                End If
            End If
        Next DeepHide_i
    Next DeepHideLevel_i
   
End Sub



' gizlenecek olarak belirlenen klasörler gizleniyor
Sub FolderDeepHide(Clss)
    ' 1:Level, 2:ObjectType, 3:ObjectName, 4:ObjectStatus, 5:ParentClass, 6:HideFlag
   
    Dim TempClsName As String
    Dim TempObjName As String
    Dim TempPdcName As String
   
    For Each Cls In Clss
        TempClsName = Cls.Name
       
        For Rn = 1 To (DeepHideIndex - 1)
            If ((DeepHideList(Rn, 6) = "True") And (TempClsName = DeepHideList(Rn, 3))) Then
                Cls.Show = False
                Cls.Description = Cls.Description & " #hide_unused_object_201709#"
                WkshtRes.Cells(Rn, 7).Value = "done"
            End If
        Next Rn
       
        If Cls.Classes.Count > 0 Then
            Call FolderDeepHide(Cls.Classes)
        End If
       
    Next Cls
   
End Sub

Bir cevap yazın