Матричное табло создавалось для примитивного вывода текста с разбиением по колонкам на экран. Может возникнуть необходимость вывода таблиц из Microsoft Excel, например на соревнованиях нужно выводить результаты участников. Это можно сделать скопировав таблицу из Excel и вставив ее в окно матричного табло, предварительно расставив маркеры табуляции в окне матричного табло.
Dim apro, elements
Set apro = GetObject("AdvertisePro:Application")
If IsNull(apro) Then
MsgBox ("Приложение не запущено")
End If
Set elements = apro.textform.Root.Children
Dim line, column
Dim scbWidth
Dim scbHeight
Dim headerLength
headerLength = Range("HeaderLength").Value
scbWidth = Range("ScbWidth").Value
scbHeight = Range("ScbHeight").Value
Dim src, colDef
Set src = Worksheets("Вывод")
Set colDef = Range("ColumnsDef")
For line = 1 To scbHeight
If (line <= headerLength) Then
elements.Item(line - 1).Value = FormatLine(src.Cells(line, 1).Value, scbWidth, Range("HeaderAlign").Value)
Else
Dim text As String
text = ""
For column = 1 To colDef.Rows.Count
Dim colWidth, colAlign
colWidth = colDef.Cells(column, 1)
colAlign = colDef.Cells(column, 2)
If colWidth > 0 Then
text = text + FormatLine(src.Cells(line, column).Value, colWidth, colAlign)
End If
Next column
elements.Item(line - 1).Value = text
End If
Next line
End Sub
Function FormatLine(text, width, align)
text = Left(CStr(text), width)
If align = "R" Then
FormatLine = Right(Space(width) + text + " ", width)
ElseIf align = "C" Or align = "С" Then
FormatLine = Left(Space((width - Len(text)) / 2) + text + Space(width), width)
Else
FormatLine = Left(text + Space(width), width)
End If
End Function
Excel поддерживает макросы, поэтому вывод на экран можно осуществить средствами самого Excel, конечно программа AdvertisePro так же должна быть запущена. В Excel мы разбираем таблицу, форматируем строку для вывода и отправляем ее в AdvertisePro.
Вот макрос:
Sub SendToScb()Dim apro, elements
Set apro = GetObject("AdvertisePro:Application")
If IsNull(apro) Then
MsgBox ("Приложение не запущено")
End If
Set elements = apro.textform.Root.Children
Dim line, column
Dim scbWidth
Dim scbHeight
Dim headerLength
headerLength = Range("HeaderLength").Value
scbWidth = Range("ScbWidth").Value
scbHeight = Range("ScbHeight").Value
Dim src, colDef
Set src = Worksheets("Вывод")
Set colDef = Range("ColumnsDef")
For line = 1 To scbHeight
If (line <= headerLength) Then
elements.Item(line - 1).Value = FormatLine(src.Cells(line, 1).Value, scbWidth, Range("HeaderAlign").Value)
Else
Dim text As String
text = ""
For column = 1 To colDef.Rows.Count
Dim colWidth, colAlign
colWidth = colDef.Cells(column, 1)
colAlign = colDef.Cells(column, 2)
If colWidth > 0 Then
text = text + FormatLine(src.Cells(line, column).Value, colWidth, colAlign)
End If
Next column
elements.Item(line - 1).Value = text
End If
Next line
End Sub
Function FormatLine(text, width, align)
text = Left(CStr(text), width)
If align = "R" Then
FormatLine = Right(Space(width) + text + " ", width)
ElseIf align = "C" Or align = "С" Then
FormatLine = Left(Space((width - Len(text)) / 2) + text + Space(width), width)
Else
FormatLine = Left(text + Space(width), width)
End If
End Function
Здесь apro - экземпляр запущенного приложения AdvertisePro, elements - объекты-строки в матричной форме. Параметры экрана (высота, ширина в символах) и определения колонок хранятся в именованных областях.
Файл для excel с полным примером можно взять здесь
На первом листе Параметры указываем параметры экрана и определяем размеры колонок. Там думаю все понятно. Указываем количество строк заголовка и ширину колонок. Выравнивание в колонках указываем буками:
R - (Right) выравниваем вправо (и добавляем один пробел, чтобы отделить от следующей колонки)
C - (Center) - выравнивание по центру
L или любой другой символ - (Left) выравнивание слева.
На второй лист "Вывод" копируем или заполняем результаты начиная с верхнего левого угла. Там же есть кнопка "Отправить" которая выводит результаты на экран.
Так же для AdvertisePro до версии 3.2.1 включительно нужно заменить файл библиотеки TextFormX.dll которая лежит в папке с программой, в старой версии была ошибка когда вставлялся текст из буфера обмена.