¡Caminando hacia el éxito!

Aprende en Comunidad

Avalados por :

Cómo extraer el color de relleno de una entidad en Excel con un script de VB

  • Creado 01/03/2024
  • Modificado 01/03/2024
  • 5 Vistas
0
Cargando...

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

Pedro Pascal
Se unió el 07/03/2018
Pinterest
Telegram
Linkedin
Whatsapp

2 Respuestas

0
Cargando...
¡Gracias Ondrej! Esto es exactamente lo que estaba buscando
Respondido el 15/04/2024
LUCIANO RIOJA GHIOTTO
Se unió el 13/07/2019
0
Cargando...

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

Respondido el 15/04/2024
LUCIANO RIOJA GHIOTTO
Se unió el 13/07/2019

contacto@primeinstitute.com

(+51) 1641 9379
(+57) 1489 6964

© 2024 Copyright. Todos los derechos reservados.

Desarrollado por Prime Institute

¡Hola! Soy Diana, asesora académica de Prime Institute, indícame en que curso estas interesado, saludos!
Hola ¿Puedo ayudarte?