Macros – Using macros to import/export attachment bindings to Excel

Introduction

When we use ER/Studio Data Architect, we can create Submodels to document specific metadata.

For example, we can create Submodels

• to manage a Conceptual Data Model,
  

  Conceptual Data Model

• to display the datatypes and Null option
  

  Datatypes and Null option

• to show the Attachments and Data Security Information bound to the Entities | Tables
  

  Attachments & Data Security Information

Sample macros are included with the installation of ER/Studio Data Architect.

• One macro allows us to export submodel, entity and attribute attachment binding information to Excel:
  Meta Data Management Macros / Attachment Binding Export to Excel
• Another one allows us to import submodel, entity and attribute attachment bindings from Excel
  Meta Data Management Macros / Attachment Bindings Import from Excel

These 2 macros are generating 1 row per Attribute ✖️ Attachment:

In this blog post, I’ll share 2 different macros which can also export|import the entity and attribute attachment binding information to|from Excel.

These macros don’t manage the submodels. They are displaying the metadata another way: it generates one row per Entity and Attribute, and it displays the different attachment properties in different columns:

Scripts

Firstly, the macro which allows us to export:

'#Language "WWB-COM"
''MACRO TITLE: wExport Attachments to Excel
' MACRO VERSION: 2.1
'This macro exports Attachments values for Entitys|Tables|Attributes|Columns
'
' Release notes
' 2.1: Add Excel comments for Text Lists
' 2.0: Add Excel optimizations
' 1.0: Initial version
'---------------------------------------------------------------------------

Option Explicit

Const TITLE As String = "wExport Attachments to Excel"
Const TIMESTAMPED As Boolean = True
Const USE_WINGDINGS As Boolean = True

Const FORMAT_FOR_DATE_WITH_EXCEL$ = "yyyy-mm-dd" ' Excel automatically changes it to the local settings
Const FORMAT_FOR_TIME_WITH_EXCEL$ = "hh:nn:ss"

Dim aLog$() ' Array of strings for the Logs

Dim MyDictionary As Dictionary
Dim dictionary_list$()

Dim MyDiagram As Diagram
Dim MyModel As Model
Dim IsLogical As Boolean
Dim MyEntityDisplay As EntityDisplay	
Dim MyEntity As Entity
Dim MyAttribute As AttributeObj

Dim MyBoundAttachment As BoundAttachment
Dim MyAttachmentType As AttachmentType
Dim MyAttachment As Attachment

' Excel variables
Dim wb As Object
Dim sheet As Object
Dim excel As Object

Dim curRow%
Dim curCol%
Dim lastCol$

Dim XLColumns4Attachments As Object

' Constants
Const BOOLEAN_TYPE% = 1
Const DATE_TYPE% = 2
Const EXTERNAL_FILE_PATH_TYPE% = 3
Const NUMERIC_TYPE% = 4
Const TEXT_TYPE% = 5
Const TEXT_LIST_TYPE% = 6
Const TIME_TYPE% = 7

Const xlCenter% = -4108
Const xlBottom% = -4107
Const xlTop% = -4160
Const xlLeft% = -4131
Const xlRight% = -4152
Const xlCalculationAutomatic& = -4105
Const xlCalculationManual& = -4135
Const xlCalculationSemiautomatic& = 2

Sub Main

	Set XLColumns4Attachments = CreateObject("Scripting.Dictionary")
	If (XLColumns4Attachments Is Nothing) Then
		MsgBox("Cannot access [Scripting.Dictionary] object.", vbExclamation)
		Exit Sub
	End If

	Dim MyListMember As ListMember
	Dim sList$
	Dim iFrom%, iTo%

	Debug.Clear
	ReDim aLog(0)

	'Get the current diagram.
	Set MyDiagram = DiagramManager.ActiveDiagram
	
	'Get the current model.
	Set MyModel = MyDiagram.ActiveModel

	' Excel
	Set excel = CreateObject("excel.application")

	PrintHeader
	' Excel optimization
	excel.Application.ScreenUpdating = False
	excel.Application.EnableAnimations = False
	excel.Application.Calculation = xlCalculationManual
	sheet.DisplayPageBreaks = False

	curCol = 3

	If init_dictionary_list Then
		Set MyDictionary = MyDiagram.Dictionary
	Else
		Begin Dialog UserDialog 550,130,TITLE ' %GRID:10,7,1,1
			Text 30,21,120,14,"Select Dictionary: ",.Text3,1
			DropListBox 170,18,360,112,dictionary_list(),.dictionary_select
			OKButton 20,105,110,21
			CancelButton 420,105,110,21
		End Dialog

		Dim dlg As UserDialog
		If Dialog(dlg) = -1 Then
			If dictionary_list(dlg.dictionary_select) = "Local" Then
				Set MyDictionary = MyDiagram.Dictionary
			Else
				Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
			End If
		Else
			Exit Sub
		End If
	End If
	
	If Not MyDictionary Is Nothing Then
		LogIt "Dictionary: " & MyDictionary.Name
		sheet.Cells(1,1).Value = If(dlg.dictionary_select = 0, "DD", "EDD") & vbCrLf & MyDictionary.Name
		' White on white
		With sheet.Cells(1,1).Font
	'		.colorindex = 15
			.ThemeColor = 1
			.TintAndShade = 0
		End With
	
		' Get all attachments
		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			For Each MyAttachment In MyAttachmentType.Attachments
	'			LogIt MyAttachmentType.Name & " / " & MyAttachment.Name
				sheet.Cells(1, curCol).Value = MyAttachmentType.Name
				sheet.Cells(2, curCol).Value = MyAttachment.Name
	
				' Center if boolean(1), date(2) or time(7)
				Select Case MyAttachment.Datatype
					Case BOOLEAN_TYPE, DATE_TYPE, TIME_TYPE
						With sheet.Columns(Chr(64 + curCol) + ":" + Chr(64 + curCol))
							.HorizontalAlignment = xlCenter
						End With

					Case TEXT_LIST_TYPE
						sList = ""
						For Each MyListMember In MyAttachment.TextList
							If MyListMember.IsDefault Then
								iFrom = Len(sList)
							End If
							sList = sList & "- " & MyListMember.Text & vbLf
							If MyListMember.IsDefault Then
								iTo = Len(sList) - 1
							End If
						Next MyListMember
						sList = Left(sList, Len(sList) - 1)
						With sheet.Cells(2, curCol)
							.AddComment
							.Comment.Visible = False
							.Comment.Text Text:= sList
						End With
						With sheet.Cells(2, curCol).Comment.Shape.TextFrame
							  .Characters.Font.Bold = False
							  .Characters(iFrom, iTo).Font.Bold = True
							  .Characters((iTo + 1), Len(sList)).Font.Bold = False
						End With

				End Select
	
				If USE_WINGDINGS And (MyAttachment.Datatype = 1) Then
					With sheet.range(Chr(64 + curCol) & "3:" & Chr(64 + curCol) & "1048576")
						.Font.Name = "Wingdings"
					End With
				End If
	
				XLColumns4Attachments(MyAttachmentType.Name & "\" & MyAttachment.Name) = curCol
				LogIt MyAttachmentType.Name & "\" & MyAttachment.Name & " = Column " & Chr(64 + curCol)
				curCol = curCol + 1
			Next MyAttachment
		Next MyAttachmentType
	
		Comments_AutoSize(sheet)

		' Excel Style for the attachments
		lastCol = Chr(63 + curCol)
		With sheet.range("C1:" & lastCol & "2")
			.interior.colorindex = 15
			.font.Size = 9
			.horizontalalignment = xlCenter
		End With
	
		curRow = 3
	
		' Loop the Entities|Tables
		For Each MyEntity In MyModel.Entities
	
			LogIt If(MyModel.Logical, "Entity: " & MyEntity.EntityName, "Table: " & MyEntity.TableName)
			' Set the Object Name
			sheet.cells(curRow, 1).Value = If(MyModel.Logical, MyEntity.EntityName, MyEntity.TableName)
			' Set Object style
			With sheet.range("A" & curRow & ":" & lastCol & curRow).interior
				.colorindex = 15
				.ThemeColor = 1
				.TintAndShade = -0.15
			End With
	
			' Loop through the Object's attachments
			For Each MyBoundAttachment In MyEntity.BoundAttachments
	
				' Set attachment object to the base attachment from the data dictionary.
				Set MyAttachment = MyBoundAttachment.Attachment

				' Check if Attachment belongs to the chosen Dictionary
				If MyAttachment.AttachmentType.DictionaryName = MyDictionary.Name Then
					' Output Entity|Table Attachments to Excel
					sheet.cells(curRow, XLColumns4Attachments(MyAttachment.AttachmentType.Name & "\" & MyAttachment.Name)).Value = GetValueforAttachment(MyAttachment, MyBoundAttachment.ValueOverride)
				End If

			Next MyBoundAttachment
	
			curRow = curRow + 1
	
			' Loop through the Object's Attributes|Columns
			For Each MyAttribute In MyEntity.Attributes
				
				LogIt If(MyModel.Logical, "Attribute: " & MyAttribute.AttributeName, "Column: " & MyAttribute.ColumnName)
				' Set the Object Name
				sheet.cells(curRow, 1).Value = If(MyModel.Logical, MyEntity.EntityName, MyEntity.TableName)
				sheet.cells(curRow, 2).Value = If(MyModel.Logical, MyAttribute.AttributeName, MyAttribute.ColumnName)
				' Set Object style
				With sheet.range("A" & curRow & ":" & lastCol & curRow).interior
					.colorindex = 15
					.ThemeColor = 1
					.TintAndShade = -0.05
				End With
	
				' Loop through the Object's attachments
				For Each MyBoundAttachment In MyAttribute.BoundAttachments
		
					' Set attachment object to the base attachment from the data dictionary.
					Set MyAttachment = MyBoundAttachment.Attachment

					' Check if Attachment belongs to the chosen Dictionary
					If MyAttachment.AttachmentType.DictionaryName = MyDictionary.Name Then
						' Output Entity|Table Attachments to Excel
						sheet.cells(curRow, XLColumns4Attachments(MyAttachment.AttachmentType.Name & "\" & MyAttachment.Name)).Value = GetValueforAttachment(MyAttachment, MyBoundAttachment.ValueOverride)
					End If

				Next MyBoundAttachment
	
				curRow = curRow + 1
	
			Next MyAttribute
	
		Next MyEntity
	
		Debug.Print ""
		LogIt "Export completed"
	
		excel.Visible = True
		excel.Application.ScreenUpdating = True
		excel.Application.EnableAnimations = True
		excel.Application.Calculation = xlCalculationAutomatic
		sheet.DisplayPageBreaks = True
		AutofitAllUsed
		sheet.Rows("1:1").RowHeight = 14.4 '.EntireRow.AutoFit

		MsgBox "Export completed !", vbInformation, TITLE
	End If
End Sub

Private Function PrefixDT(txt As String) As String
	If TIMESTAMPED Then
		PrefixDT = CStr(Now) & Chr(9) & txt
	Else
		PrefixDT = txt
	End If
End Function

Private Sub LogIt(ByVal txt As String)
	Dim idx As Integer

	idx = UBound(aLog) + 1
	ReDim Preserve aLog(idx)
	aLog(idx) = PrefixDT(txt)

	Debug.Print PrefixDT(txt)
End Sub

Private Sub PrintHeader

	Set wb = excel.workbooks.Add
	Set sheet = wb.activesheet

	sheet.Name = "Attachments"

	With sheet.range("A2:B2")
		.interior.colorindex = 15
		.font.Bold = True
		.font.Size = 9
	End With

	With excel
		With .ActiveWindow
			.SplitColumn = 2
			.SplitRow = 2
		End With
		.ActiveWindow.FreezePanes = True
	End With

	sheet.cells(1,2).Value = "Type / Attachment"
	sheet.cells(2,2).Value = If(MyModel.Logical, "Attributes", "Columns")
	sheet.cells(2,1).Value = If(MyModel.Logical, "Entities", "Tables")

	With sheet.cells(2,2).Borders(5)
		.LineStyle = 1
		.ColorIndex = 0
		.TintAndShade = 0
		.Weight = 2
	End With

	sheet.Rows("2:2").RowHeight = 20

	With sheet.range("A:B")
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
	End With

	With sheet.cells(1,2)
		.horizontalalignment = xlRight
		.interior.colorindex = 15
		.font.Bold = True
		.font.Size = 9
	End With

End Sub

Private Sub AutofitAllUsed
	Dim x As Long

	For x = 1 To Excel.ActiveSheet.UsedRange.Columns.Count
		excel.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
	Next x
End Sub

Private Function GetValueforAttachment(theAttachment As Attachment, ByVal value As String) As String

	Dim dt, tm As Date
	Dim S As String

	GetValueforAttachment = ""

	If (theAttachment Is Nothing) Then
		Exit Function
	End If

	If (value = "") Then
		value = theAttachment.ValueDefault
	End If

	If value = "" Then
		Exit Function
	End If

	Select Case theAttachment.Datatype
		Case BOOLEAN_TYPE
			GetValueforAttachment = If(USE_WINGDINGS, If(CBool(value), "þ", "¨"), CStr(CBool(value)))
		Case EXTERNAL_FILE_PATH_TYPE
			GetValueforAttachment = value
		Case NUMERIC_TYPE
			GetValueforAttachment = CStr(CInt(value))
		Case TEXT_TYPE
			GetValueforAttachment = value
		Case DATE_TYPE
			dt = CStr(CDate(value))
			S = Format(dt, FORMAT_FOR_DATE_WITH_EXCEL)
			GetValueforAttachment = S
		Case TIME_TYPE
			tm = CStr(CDate(value))
			S = Format(tm, FORMAT_FOR_TIME_WITH_EXCEL)
			GetValueforAttachment = S
		Case TEXT_LIST_TYPE
			GetValueforAttachment = value
	End Select
End Function

' Initialize the dictionary drop down list
Function init_dictionary_list As Boolean
	Dim i%

	ReDim dictionary_list$(0 To MyDiagram.EnterpriseDataDictionaries.Count)

	dictionary_list (0) = "Local"
	i = 1

	For Each MyDictionary In MyDiagram.EnterpriseDataDictionaries
		dictionary_list (i) = MyDictionary.Name
		i = i + 1
	Next

	init_dictionary_list = MyDiagram.EnterpriseDataDictionaries.Count = 0
End Function

Sub Comments_AutoSize(s As Object)
	' https://www.contextures.com/xlcomments03.html
	Dim MyComments As Object
	Dim lArea As Long
	Dim lMult As Double
	Dim MaxW As Long
	Dim NewW As Long
	
	'Height adjustment factor
	 'of 1.1 seems to work ok.
	lMult = 1.1
	MaxW = 300
	NewW = 200
	
	For Each MyComments In s.Comments
	  With MyComments
		.Shape.TextFrame.AutoSize = True
		If .Shape.Width > MaxW Then
		  lArea = .Shape.Width * .Shape.Height
		  .Shape.Width = NewW
		  .Shape.Height = (lArea / NewW) * lMult
		End If
	  End With
	Next ' comment
End Sub

Then the macro to import:

'#Language "WWB-COM"
''MACRO TITLE: wImport Attachments from Excel
' MACRO VERSION: 1.0
'This macro imports Attachments values for Entities|Tables|Attributes|Columns
'---------------------------------------------------------------------------

Option Explicit

Const TITLE As String = "wImport Attachments from Excel"
Const USE_WINGDINGS As Boolean = True ' Used for the spreadsheet Sample

Dim MyDictionary As Dictionary
Dim dictionary_list$()

Dim MyDiagram As Diagram
Dim MyModel As Model
Dim MyEntity As Entity
Dim MyAttribute As AttributeObj

Dim MyAttachments() As Attachment
Dim MyAttachment As Attachment
Dim MyBoundAttachment As BoundAttachment

' Excel variables
Dim wb As Object
Dim sheet As Object
Dim excel As Object
Dim XLfile$

Dim curRow%
Dim curCol%
Dim lastCol$
Dim lNbAttachments&
Dim sCurrentCell$

' Constants
Const BOOLEAN_TYPE% = 1
Const DATE_TYPE% = 2
Const EXTERNAL_FILE_PATH_TYPE% = 3
Const NUMERIC_TYPE% = 4
Const TEXT_TYPE% = 5
Const TEXT_LIST_TYPE% = 6
Const TIME_TYPE% = 7

Const xlCenter% = -4108
Const xlBottom% = -4107
Const xlTop% = -4160
Const xlLeft% = -4131
Const xlRight% = -4152

Sub Main
	Dim lNBUpdates&
	Debug.Clear

	Set MyDiagram = DiagramManager.ActiveDiagram
	Set MyModel = MyDiagram.ActiveModel

	Begin Dialog UserDialog 550,196,TITLE,.DialogFunc ' %GRID:10,7,1,1
		Text 30,21,120,14,"Select Dictionary: ",.Text3,1
		DropListBox 170,18,360,112,dictionary_list(),.dictionary_select
		GroupBox 20,56,510,98,"Excel spreadsheet",.gbPath
		Text 30,84,50,14,"Path: ",.Text1,1
		TextBox 90,83,360,21,.Path
		PushButton 460,84,60,21,"Browse",.Browse
		PushButton 350,119,170,28,"Generate a Sample Sheet",.SampleSheet
		OKButton 20,168,110,21
		CancelButton 420,168,110,21
	End Dialog

	Dim dlg As UserDialog

	init_dictionary_list

	start_dialog:

	'start dialog
	If Dialog(dlg) = -1 Then

		If dictionary_list(dlg.dictionary_select) = "Local" Then
			Set MyDictionary = MyDiagram.Dictionary
		Else
			Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
		End If

		'initialize excel object and make visible
		Set excel = CreateObject("Excel.Application")

		'this Error Is For an errant file path, Dialog will be restarted
		On Error GoTo Error_open

		XLfile = dlg.Path
		excel.workbooks.Open XLfile
	
		On Error GoTo Error_unknown

		DiagramManager.EnableScreenUpdateEx(False, False)

		lNBUpdates = ImportAttachments(excel)

		DiagramManager.EnableScreenUpdateEx(True, True)

		excel.Quit()
		MsgBox ("File imported" & vbCrLf & vbCrLf & lNBUpdates & " update" & If(lNBUpdates > 1, "s", ""), vbInformation, TITLE)
		Debug.Print lNBUpdates & " update" & If(lNBUpdates > 1, "s", "") & " done"
	
		Exit Sub
	
		Error_open:
			MsgBox("Please enter a valid path.", vbExclamation, TITLE)
			GoTo start_dialog

		Error_unknown:
			MsgBox(Err.Description & If(sCurrentCell <> "", vbCrLf & vbCrLf & "Last Excel cell used: " & sCurrentCell, ""), vbExclamation, TITLE)
		
			If Not excel Is Nothing Then
				excel.Quit()
			End If

	End If

End Sub

'initialize the dictionary drop down list
Sub init_dictionary_list
	Dim i%

	ReDim dictionary_list$(0 To MyDiagram.EnterpriseDataDictionaries.Count)

	dictionary_list (0) = "Local"
	i = 1

	For Each MyDictionary In MyDiagram.EnterpriseDataDictionaries
		dictionary_list (i) = MyDictionary.Name
		i = i + 1
	Next
End Sub

Private Function ImportAttachments(ex As Variant) As Integer

	Dim sheet As Object
	Dim range As Object

	Dim lNbRows&
	Dim sValue$
	Dim lCurCol&, lCurRow&
	Dim lNbAttachmentsManaged&

	Dim MyAttachmentType As AttachmentType

	Dim sLastAttachmentType$, sLastEntity$, sLastAttribute$

	Set sheet = ex.worksheets(1)
	Set range = sheet.usedrange
	range.Select
	sLastAttachmentType = ""

	ImportAttachments = 0

	lNbAttachments = range.Columns.Count
	Debug.Print "Number of attachments: " & (lNbAttachments - 2)

	ReDim MyAttachments(lNbAttachments)

	For lCurCol = 3 To lNbAttachments
		sValue = Trim(CStr(range.Cells(1, lCurCol).Value))
		If (sValue <> "") Then
			If (sValue <> sLastAttachmentType) Then
				Set MyAttachmentType = MyDictionary.AttachmentTypes(sValue)
				' Check if AttachmentType exists
				If MyAttachmentType Is Nothing Then
					' Attachment type not found, we create it
					Set MyAttachmentType = MyDictionary.AttachmentTypes.Add(sValue, "Imported from file: " & XLfile)
				End If
				sLastAttachmentType = sValue
			End If

			sValue = Trim(CStr(range.Cells(2, lCurCol).Value))
			If (sValue <> "") Then
				Set MyAttachment = MyAttachmentType.Attachments(sValue)
				' Check if Attachment exists
				If MyAttachment Is Nothing Then
					' Attachment not found, we create it
					Set MyAttachment = MyAttachmentType.Attachments.Add(sValue,  "Imported from file: " & XLfile, "", TEXT_TYPE)
					Debug.Print "Attachment created: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				Else
					Debug.Print "Attachment found: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				End If
				' Store a reference to the attachment object with the column index
				Debug.Print Chr(9) & "column: " & Chr(64 + lCurCol) & "(" & lCurCol & ")"
				Set MyAttachments(lCurCol) = MyAttachment
			End If

		End If
	Next lCurCol

	lNbRows = range.rows.Count
	Debug.Print "Number of rows: " & (lNbRows - 2)
	sLastEntity = ""
	sLastAttribute = ""
	lNbAttachmentsManaged = 0

	' Loop Rows
	For lCurRow = 3 To lNbRows
		' Entity|Table
		sValue = Trim(CStr(range.Cells(lCurRow, 1).Value))
		If (sValue <> "") Then
			If (sValue <> sLastEntity) Then
				Set MyEntity = MyModel.Entities(sValue)
				sLastEntity = sValue
			End If
			' Check if Entity|Table exists
			If Not(MyEntity Is Nothing) Then
				' Entity|Table found, check if it's an Attribute|Column
				sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
				If (sValue <> "") Then
					' This row if for an Attribute|Column
					If (sValue <> sLastAttribute) Then
						Set MyAttribute = MyEntity.Attributes(sValue)
						sLastAttribute = sValue
					End If
					' Check if Attribute|Column exists
					If Not(MyAttribute Is Nothing) Then
						' Attribute|Column found
						' Manage the Attachments
						Debug.Print If(MyModel.Logical, "Attribute", "Column") & ": " & sLastEntity & " \ " & sLastAttribute
						lNbAttachmentsManaged = lNbAttachmentsManaged + ManageAttachments(MyAttribute.BoundAttachments, range, lCurRow)
					Else
						Debug.Print If(MyModel.Logical, "Attribute", "Column") & " not found: " & sLastEntity & " \ " & sLastAttribute
					End If
				Else
					' This row is for an Entity|Table
					' Manage the Attachments
					Debug.Print If(MyModel.Logical, "Entity", "Table") & ": " & sLastEntity
					lNbAttachmentsManaged = lNbAttachmentsManaged + ManageAttachments(MyEntity.BoundAttachments, range, lCurRow)
				End If
			Else
				Debug.Print If(MyModel.Logical, "Entity", "Table") & " not found: " & sLastEntity
			End If
		Else
			Debug.Print "Cell for the " & If(MyModel.Logical, "Entity", "Table") & " is Empty"
		End If
	Next lCurRow

	ImportAttachments = lNbAttachmentsManaged
End Function

Private Function ManageAttachments(MyBoundAttachments As BoundAttachments, range As Object, lCurRow&) As Integer
	Dim sValue$
	Dim lCurCol&
	Dim dt As Date

	ManageAttachments = 0

	' Loop Attachments
	For lCurCol = 3 To lNbAttachments
		sCurrentCell = Chr(64 + lCurCol) & lCurRow
		sValue = Trim(CStr(range.Cells(lCurRow, lCurCol).Value))
		' There's a value in the cell
		If (sValue <> "") Then
			' Convert/Format the value to a string
			Set MyAttachment = MyAttachments(lCurCol)
			Select Case MyAttachment.Datatype
			Case NUMERIC_TYPE
				sValue = CStr(CInt(sValue))
			Case DATE_TYPE
				dt = CStr(CDate(sValue))
				sValue = Format(dt, "MM/DD/YYYY")
			Case TIME_TYPE
				dt = CStr(CDate(sValue)) ' Type checking through casting
				sValue = Format(dt, "hh:nn:ssAMPM") ' Expected ER/Studio format
			Case BOOLEAN_TYPE
				sValue = CStr(CBool(If(sValue = "þ", "TRUE", If(sValue = "¨", "FALSE", sValue)))) ' Replace Windings checkboxes: þ|¨
			End Select

			' Check If the Attachment is already bound to the Object
			Set MyBoundAttachment = MyBoundAttachments(MyAttachment.ID)
			If MyBoundAttachment Is Nothing Then
				' Attachment not bound, adding it
				Set MyBoundAttachment = MyBoundAttachments.Add(MyAttachment.ID)
			End If
			MyBoundAttachment.ValueOverride = If(MyAttachment.ValueDefault <> sValue, sValue, "")
			ManageAttachments = ManageAttachments + 1
		End If
	Next lCurCol
	sCurrentCell = ""
End Function

Sub PrintSampleSheet()
	Dim sample As Object
	Dim wb, ws As Variant

	Set sample = CreateObject("excel.application")
	sample.visible = True

	Set wb = sample.workbooks.Add
	Set ws = wb.activesheet

	ws.Name = "Attachments"

	With ws.range("A2:B2")
		.interior.colorindex = 15
		.font.Bold = True
		.font.Size = 9
	End With

	With sample
		With .ActiveWindow
			.SplitColumn = 2
			.SplitRow = 2
		End With
		.ActiveWindow.FreezePanes = True
	End With

	ws.cells(1,2).Value = "Type / Attachment"
	ws.cells(2,2).Value = If(MyModel.Logical, "Attributes", "Columns")
	ws.cells(2,1).Value = If(MyModel.Logical, "Entities", "Tables")

	With ws.cells(2,2).Borders(5)
		.LineStyle = 1
		.ColorIndex = 0
		.TintAndShade = 0
		.Weight = 2
	End With

	ws.Rows("2:2").RowHeight = 20

	With ws.range("A:B")
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
	End With

	With ws.cells(1,2)
		.horizontalalignment = xlRight
		.interior.colorindex = 15
		.font.Bold = True
		.font.Size = 9
	End With

	ws.Cells(1, 3).Value = "Attachment Type A"
	ws.Cells(2, 3).Value = "Attachment 1"
	ws.Cells(1, 4).Value = "Attachment Type A"
	ws.Cells(2, 4).Value = "Attachment 2"
	ws.Cells(1, 5).Value = "Attachment Type B"
	ws.Cells(2, 5).Value = "Attachment I"
	ws.Cells(1, 6).Value = "Attachment Type B"
	ws.Cells(2, 6).Value = "Attachment II"
	ws.Cells(1, 7).Value = "Attachment Type B"
	ws.Cells(2, 7).Value = "Attachment III"

	With ws.Range(ws.Cells(1, 3),ws.Cells(2, 7))
		.interior.colorindex = 15
		.font.Size = 9
		.horizontalalignment = xlCenter
	End With

	With ws.Range(ws.Cells(3, 5),ws.Cells(8, 7))
		.HorizontalAlignment = xlCenter
	End With

	If USE_WINGDINGS Then
		With ws.Range(ws.Cells(3, 7),ws.Cells(7, 7))
			.Font.Name = "Wingdings"
		End With
	End If

	With ws.Range(ws.Cells(3, 1),ws.Cells(3, 7)).interior
		.colorindex = 15
		.ThemeColor = 1
		.TintAndShade = -0.15
	End With
	With ws.Range(ws.Cells(6, 1),ws.Cells(6, 7)).interior
		.colorindex = 15
		.ThemeColor = 1
		.TintAndShade = -0.15
	End With

	With ws.Range(ws.Cells(4, 1),ws.Cells(5, 7)).interior
		.colorindex = 15
		.ThemeColor = 1
		.TintAndShade = -0.05
	End With
	With ws.Range(ws.Cells(7, 1),ws.Cells(8, 7)).interior
		.colorindex = 15
		.ThemeColor = 1
		.TintAndShade = -0.05
	End With

	#Region "Sample"
	ws.Cells(3, 1).Value = "Entity 1"
	ws.Cells(3, 2).Value = ""
	ws.Cells(3, 3).Value = "Green"
	ws.Cells(3, 4).Value = "Dog"
	ws.Cells(3, 5).Value = "2024-02-29"
	ws.Cells(3, 6).Value = "08:30:45"
	ws.Cells(3, 7).Value = If(USE_WINGDINGS, "þ", "TRUE")

	ws.Cells(4, 1).Value = "Entity 1"
	ws.Cells(4, 2).Value = "Attribute A"
	ws.Cells(4, 3).Value = "Yellow"
	ws.Cells(4, 4).Value = "Cat"
	ws.Cells(4, 5).Value = "2020-02-29"
	ws.Cells(4, 6).Value = "18:30:45"
	ws.Cells(4, 7).Value = If(USE_WINGDINGS, "¨", "FALSE")

	ws.Cells(5, 1).Value = "Entity 1"
	ws.Cells(5, 2).Value = "Attribute B"
	ws.Cells(5, 3).Value = "Yellow"
	ws.Cells(5, 4).Value = "Fish"
	ws.Cells(5, 5).Value = "2023-12-25"
	ws.Cells(5, 6).Value = "0:00:00"
	ws.Cells(5, 7).Value = If(USE_WINGDINGS, "¨", "FALSE")


	ws.Cells(6, 1).Value = "Entity 2"
	ws.Cells(6, 2).Value = ""
	ws.Cells(6, 3).Value = "White"
	ws.Cells(6, 4).Value = "Bird"
	ws.Cells(6, 5).Value = "2024-01-01"
	ws.Cells(6, 6).Value = "19:12:32"
	ws.Cells(6, 7).Value = If(USE_WINGDINGS, "¨", "FALSE")

	ws.Cells(7, 1).Value = "Entity 2"
	ws.Cells(7, 2).Value = "Attribute A"
	ws.Cells(7, 3).Value = "Purple"
	ws.Cells(7, 4).Value = "Horse"
	ws.Cells(7, 5).Value = "1999-12-31"
	ws.Cells(7, 6).Value = "23:59:59"
	ws.Cells(7, 7).Value = If(USE_WINGDINGS, "þ", "TRUE")

	ws.Cells(8, 1).Value = "..."
	ws.Cells(8, 2).Value = "..."
	ws.Cells(8, 3).Value = "..."
	ws.Cells(8, 4).Value = "..."
	ws.Cells(8, 5).Value = "..."
	ws.Cells(8, 6).Value = "..."
	ws.Cells(8, 7).Value = "..."
	#End Region

	AutofitAllUsed(sample)

	Debug.Print "Sample generated"
	MsgBox "Sample generated", vbInformation, TITLE
End Sub

Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization
	Case 2 ' Value changing or button pressed
		If DlgItem = "Browse" Then
			'browse to excel file if used pushes browse button.  Put path in text box.
			DlgText "path", GetFilePath(,"All Excel Files (*.xlsx;*.xls;*.xlsm)|*.xlsx;*.xls;*.xlsm|Excel Workbook (*.xlsx)|*.xlsx|Excel Macro-enabled Workbook (*.xslm)|*.xslm|Excel 97-2003 Workbook (*.xls)|*.xls|All Files (*.*)|*.*",,"Open SpreadSheet", 0)
			DialogFunc = True
		ElseIf DlgItem = "SampleSheet" Then
			PrintSampleSheet
			DialogFunc = True
		ElseIf DlgItem = "OK" And DlgText("path") = "" Then
			'don't exit dialog if a path is not specified
			MsgBox("Please enter a valid path.", vbExclamation, TITLE)
			DialogFunc = True
		End If
		Rem DialogFunc = True ' Prevent button press from closing the dialog box
	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem DialogFunc = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function

Private Sub AutofitAllUsed(excelObj)
	If excelObj Is Nothing Then
		Set excelObj = excel
	End If

	Dim x As Long

	For x = 1 To excelObj.ActiveSheet.UsedRange.Columns.Count
		excelObj.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
	Next x
End Sub

As usual, feel free to update the code to get your custom requirements.

Bonus

A short video which shows how to create a macro from a script in ER/Studio Data Architect: