Önceki iki yazıda (birinci yazı, ikinci yazı) paylaşılan kodun tam tersini, yani gizleme yerine gösterme, yapan kod. İlgili objeleri görünür hale getirip gerekiyorsa üst klasörlerini de görünür hale getiren VBA Script.
Kod indirme adresi:
UnhideWithParents.xlsm.zip
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:HideChangeFlag
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("/Universes/ayhan_deneme", "base_unv_for_link")
'DesignerApp.Visible = False
Set Wksht = ThisWorkbook.Worksheets("Objects")
Wksht.Unprotect
WorksheetRowCount = Wksht.UsedRange.Rows.Count
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 CalculateDeepUnhide(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 FolderDeepUnhideClasses(Univ.Classes)
Call FolderDeepUnhideObjects(Univ.Classes)
'WkshtRes.Protect
'WkshtDoc.Protect
'Wksht.Protect
End Sub
' klasörler, objeler, filtreler üzerinde özyinelemeli gezilerek listedeki objeler görünür hale getiriliyor ve varsa açıklamasındaki kısım siliniyor
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 = False) Then
Obj.Show = True
Obj.Description = Replace(Replace(Replace(Obj.Description, " #hide_unused_object_201709#", ""), "#hide_unused_object_201709#", ""), "#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 = False) Then
Pdc.Show = True
Pdc.Description = Replace(Replace(Replace(Pdc.Description, " #hide_unused_object_201709#", ""), "#hide_unused_object_201709#", ""), "#Hide_Unused_Object_201709", "")
End If
Next Pdc
If Cls.Classes.Count > 0 Then
Call GoClasses(Cls.Classes)
End If
Next Cls
End Sub
' hata ayıklayabilmek ve yapılan işlemleri takip edebilmek için universe objeleri excel in Doc sheet ine yaı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) = Cls.Show ' "True" ' object status
DeepHideList(DeepHideIndex, 5) = DeepHideParentClassName ' parent class
DeepHideList(DeepHideIndex, 6) = "False" ' hide change flag
DeepHideIndex = DeepHideIndex + 1
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) = Obj.Show ' "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 change 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) = Pdc.Show ' "True" ' object status
DeepHideList(DeepHideIndex, 5) = TempClsName ' parent class
DeepHideList(DeepHideIndex, 6) = "False" ' hide change 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
' görünür hale getirilen objeler sebebiyle görünür yapılması gereken üst klasörler var mı diye hesaplanıyor
Sub CalculateDeepUnhide(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 (DeepHideList(DeepHide_i, 4) = "False") 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 = 1) Then
DeepHideList(DeepHide_i, 4) = "True" ' object status
DeepHideList(DeepHide_i, 6) = "True" ' hide change flag
End If
End If
Next DeepHide_i
Next DeepHideLevel_i
End Sub
' hesaplama sonucu görünürlüğü değiştirilecek objelerin görünürlüğü aktif hale getiriliyor
Sub FolderDeepUnhideClasses(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 = True
Cls.Description = Replace(Replace(Replace(Cls.Description, " #hide_unused_object_201709#", ""), "#hide_unused_object_201709#", ""), "#Hide_Unused_Object_201709", "")
WkshtRes.Cells(Rn, 7).Value = "done"
End If
Next Rn
If Cls.Classes.Count > 0 Then
Call FolderDeepUnhideClasses(Cls.Classes)
End If
Next Cls
End Sub
' klasör görünür hale getirilince altındaki tüm objeler de görünür duruma dönüştüğü için fazladan dönüşen objeler ilk görünürlük hallerine çevriliyor
Sub FolderDeepUnhideObjects(Clss)
' 1:Level, 2:ObjectType, 3:ObjectName, 4:ObjectStatus, 5:ParentClass, 6:HideFlag
Dim TempClsName As String
Dim TempObjName As String
Dim TempObjShow As String
Dim TempPdcName As String
Dim TempPdcShow As String
Dim DeepHide_i As Integer
Dim Change_i As Integer
For Each Cls In Clss
TempClsName = Cls.Name
For Each Obj In Cls.Objects
TempObjName = Obj.Name
TempObjShow = Obj.Show
For DeepHide_i = 1 To (DeepHideIndex - 1)
Change_i = 0
If (TempClsName = DeepHideList(DeepHide_i, 5) And TempObjName = DeepHideList(DeepHide_i, 3)) Then
If (TempObjShow = DeepHideList(DeepHide_i, 4)) Then
Change_i = 0
Else
Change_i = 1
End If
Exit For
End If
Next DeepHide_i
If (Change_i = 1) Then
Obj.Show = DeepHideList(DeepHide_i, 4)
WkshtRes.Cells(DeepHide_i, 8).Value = "done"
End If
Next Obj
For Each Pdc In Cls.PredefinedConditions
TempPdcName = Pdc.Name
TempPdcShow = Pdc.Show
For DeepHide_i = 1 To (DeepHideIndex - 1)
Change_i = 0
If (TempClsName = DeepHideList(DeepHide_i, 5) And TempPdcName = DeepHideList(DeepHide_i, 3)) Then
If (TempPdcShow = DeepHideList(DeepHide_i, 4)) Then
Change_i = 0
Else
Change_i = 1
End If
Exit For
End If
Next DeepHide_i
If (Change_i = 1) Then
Pdc.Show = DeepHideList(DeepHide_i, 4)
WkshtRes.Cells(DeepHide_i, 8).Value = "done"
End If
Next Pdc
If Cls.Classes.Count > 0 Then
Call FolderDeepUnhideObjects(Cls.Classes)
End If
Next Cls
End Sub
