Avalados por :
Hola a todos,
Tengo un script de vb que recorre todos los modelos de datos lógicos abiertos y extrae los datos del modelo en una hoja de cálculo de Excel, como modelo, entidad, atributo, comentarios, atributo(s) extendido(s), etc. Lo que me está resultando difícil es extraer el color de relleno de la entidad, que es necesario para el análisis. A continuación se muestra mi script completo. ¿Alguien podría ayudar? Gracias de antemano.
----------------------------------
Option Explicit
Dim nb
Dim HaveExcel
Dim x1
Dim mdl ' el modelo actual
Dim models ' la colección de modelos
HaveExcel= False
Dim RQ
RQ = MsgBox ("¿Excel está instalado en su máquina?", vbYesNo + vbInformation,"Confirmación")
if RQ= VbYes then
HaveExcel= True
Set x1 = CreateObject("Excel.Application")
x1.Visible = True
x1.Workbooks.Add
x1.Range("A1").Value = "Nombre del Modelo"
x1.Range("B1").Value = "Nombre de la Clase"
x1.Range("C1").Value = "Nombre del Objeto"
x1.Range("D1").Value = "Código del Objeto"
x1.Range("E1").Value = "Comentarios del Objeto"
x1.Range("F1").Value = "Nombre del Atributo"
x1.Range("G1").Value = "Atributo ExtendidoX"
end If
Set models = Application.Models
if models.Count = 0 then
MsgBox ("No hay modelos en el espacio de trabajo actual.")
end if
Dim sheetIndex
sheetIndex = 1
For Each mdl In models
nb = 2
If sheetIndex > 1 Then
x1.Worksheets.Add , x1.Worksheets(sheetIndex - 1)
End If
x1.Worksheets(sheetIndex).Name = "LDM_" & sheetIndex
With x1.Worksheets(sheetIndex)
x1.Range("A1").Value = "Nombre del Modelo"
x1.Range("B1").Value = "Nombre de la Clase"
x1.Range("C1").Value = "Nombre del Objeto"
x1.Range("D1").Value = "Código del Objeto"
x1.Range("E1").Value = "Comentarios del Objeto"
x1.Range("F1").Value = "Nombre del Atributo"
x1.Range("G1").Value = "Atributo ExtendidoX"
End With
ListObjects(mdl)
if HaveExcel= True Then
x1.Worksheets(sheetIndex).Columns("A:G").EntireColumn.AutoFit
end if
sheetIndex = sheetIndex + 1
Next
Sub ListObjects(fldr)
Dim obj ' objeto en ejecución
For Each obj In fldr.Children
DescribeObject obj
Next
Dim f ' carpeta en ejecución
For Each f In fldr.Packages
ListObjects f
Next
End Sub
Sub DescribeObject(CurrentObject)
if CurrentObject.ClassName ="Vínculo de Clase de Asociación" then exit sub
if HaveExcel= True Then 'Exportar información al documento de Excel
If CurrentObject.ClassName = "Entidad" Then
Dim attr
Dim hasAttributes
hasAttributes = (CurrentObject.Attributes.Count > 0)
If hasAttributes Then
For Each attr In CurrentObject.Attributes
WriteToExcel CurrentObject, attr
Next
Else
WriteToExcel CurrentObject, Nothing
End If
Else
WriteToExcel CurrentObject, Nothing
End If
End If
End Sub
Sub WriteToExcel(obj, attr)
x1.Range("A" & Cstr(nb)).Value = mdl.Name
x1.Range("B" & Cstr(nb)).Value = obj.ClassName
x1.Range("C" & Cstr(nb)).Value = obj.Name
x1.Range("D" & Cstr(nb)).Value = obj.Code
x1.Range("E" & Cstr(nb)).Value = obj.Comment
If Not attr is Nothing Then
x1.Range("F" & Cstr(nb)).Value = attr.Name
Else
x1.Range("F" & Cstr(nb)).Value = ""
End If
Dim extAttribute
extAttribute = ""
If obj.HasExtendedAttribute("Atributo ExtendidoX") Then
extAttribute = obj.GetExtendedAttribute("Atributo ExtendidoX")
End If
Hola Lawrence,
así es como puedes obtener la representación RGB del FillColor de entidades lógicas.
Para cada e en ActiveModel.Entities
Para cada s en e.Symbols
output s.Name + " - " + s.ObjectType
output s.FillColor
decimalColor = s.FillColor ' sym es el objeto de símbolo
val1 = (decimalColor and 255)
val2 = (decimalColor and 255*256)/256
val3 = (decimalColor and 255*256*256)/(256*256)
output "RGB(" & val1 & ", " & val2 & ", " & val3 & ")"
Siguiente
Siguiente
Y así es como puedes establecer el color de tus entidades.
s.FillColor = RGB (255, 0, 0) 'esto establece fillColor en rojo.
En caso de que necesites más ayuda con tu script, avísame (puedes encontrarme fácilmente en LinkedIn).
Saludos,
Ondrej Divis
contacto@primeinstitute.com
(+51) 1641 9379
(+57) 1489 6964
© 2024 Copyright. Todos los derechos reservados.
Desarrollado por Prime Institute