Експорт звітів в HTML, MS Office, Програмні керівництва, статті

 


MS Access 2000, під яким я зараз сиджу – гідний пам’ятник тих часів, коли одна відома людина думав, що Інтернет “малоперспективен”.


Через те саме місце, яким він у цей момент думав, в MS Access 2000 зроблені і експорт в HTML, і можливість відправки звіту по емейлу.


Поки в моїй програмі звіт, який потрібно було посилати по емйлу, був один – я писав программульку “конвертації індивідуально для нього.
Але покупці оцінили можливість відправки звіту по емейлу – причому в тілі листа. Число звітів тепер з катастрофічною швидкістю зростає – і доводиться вигадувати щось хоч трохи уіверсальное.


Причому вкрай важливо придумати щось таке, щоб чуйно реагувала на Зміна МАКЕТУ звітів.
Підтримувати-то програму треба … І дещо я придумав. Може, це допоможе і Вам.


Attribute VB_Name = “export_to_HTML”
Option Compare Database
Option Explicit
Public subreportHTML As String


“1. Як нам облаштувати експорт
“———————————
“У звіту в Аксесс є такі області: заголовок, верхній колонтитул, дані, нижній колонтитул, примітка
“У всіх у них сть подія” Форматування “(Format). Саме на нього має сенс вішати програму, що перетворює зміст
“Області в HTML-код


“Всі ці програми можуть дописувати один і той же файл.
“(Якщо Ви вважаєте, що розумніші збирати код в змінну String – я погоджуся, але нагадаю,
“Що ТУТ ВАМ НЕ ТУТ: в MS Access стринг-змінна в один не самий кращий момент просто перестає збільшуватися, нічого не повідомляючи системі і Вашій програмі)


“Отже, для областей звіту потрібна функція, що пробігає контроли і зберігає їх зміст та оформлення в HTML


“Напишемо функцію section_to_HTML (), яка це зробить. Вона перетворює секцію в DIV
“З абсолютною позицією, і всередині нього позиціонуватиме все контроли


“В Аксесс є корисні констатувати для позначення типів контрола:


“AcBoundObjectFrame Приєднана рамка об’єкта
“AcCheckBox Прапорець
“AcComboBox Комбобокс (випадаючий список)
“AcCommandButton Кнопка
“acCustomControl    ActiveX (custom) control
“AcImage Картинка
“AcLabel напис
“AcLine лінія
“AcListBox список
“AcObjectFrame вільна рамка об’єкту
“AcOptionButton перемикач (Радіокнопка)
“AcOptionGroup група елементів управління
“acPage             Page
“acPageBreak        Page break
“AcRectangle Прямокутник
“AcSubform підпорядкована форма / звіт
“AcTabCtl Набір вкладок
“AcTextBox текстове поле
“AcToggleButton перемикач (” залипающий “кнопка)


“2. Так почнемо ж функцію цю …
“———————————-


Function section_to_HTML(ByRef our_section As Section, ByVal n As Integer, ByVal top As Long, Optional ByRef output As String) As Long
“Our_section – заголовок або примітка
“N – дескриптор файлу, в який пишемо
“Якщо дорівнює нулю – нікуди не пишемо
“Top – скільки відступити від початку сторінки в твіп (1мм = 56.7 твіп)
“Цю величину доведеться вираховувати в процесі формування файлу
“Output – У цю змінну збирається весь HTML-код секції
“Рекомендується використовувати тільки для зовсім маленьких секцій:
“Змінна типу String всупереч документації може” переповнитися “


On Error GoTo oblom


Dim html As String


html = vbCrLf & “<div style=””position:absolute;width:”
html = html & Int (our_section.Parent.width / 56.7) “ширина звіту в мм
html = html & “mm;height:” & Str(round(our_section.Height, 2)) & “mm”
html = html & “;top:” & top & “mm”
html = html & “;background-color:” & toRGB(our_section.BackColor)
html = html & “””>” & vbCrLf


output = output & html
If (n <> 0) Then Print #n, html


“Тепер пробігаємо контроли
“Відсортуємо їх за зростанням властивості TOP, а потім LEFT
“(Зверху вниз і зліва направо)
“Для цього заженемо їх у таблицю (щоб з масивами не боротися)


“Перевіримо, чи є таблиця tmpControls
Dim t As Dao.TableDef
Dim exists As Boolean
exists = False
For Each t In CurrentDb.TableDefs
    If t.Name = “tmpControls” Then
        exists = True
        Exit For
    End If
Next t


If exists Then “Є таблиця
    CurrentDb.Execute (“delete from tmpControls”)
Else “Немає таблиці tmpControls. Зараз буде
    
    Dim tbl As Dao.TableDef


    Set tbl = CurrentDb.CreateTableDef(“tmpControls”)
    
    With tbl
. Fields.Append. CreateField (“top_”, dbLong) “Щоб впорядкувати за відступу від верху
. Fields.Append. CreateField (“left_”, dbLong) “Щоб впорядкувати за відступу зліва
        .Fields.Append .CreateField(“controlName”, dbText)
    End With
    
    CurrentDb.TableDefs.Append tbl
    CurrentDb.TableDefs.Refresh
End If


“Отже, таблиця tmpControls з двома полями у нас є (в кінці функції ми її … того ..)
“Заповнимо таблицю


Dim ctrl As Control
Dim p As Property
Dim query As String


For Each ctrl In our_section.Controls
    If (ctrl.Properties(“Visible”) = True) Then
        query = “insert into tmpControls (top_,left_,controlName)”
        query = query & ” values (” & ctrl.Properties(“Top”) & “,” & ctrl.Properties(“Left”) & “,”” & ctrl.Properties(“Name”) & “”)”
        CurrentDb.Execute (query)
    End If
Next ctrl


Set ctrl = Nothing


“Отже, таблиця tmpControls заповнена
“Пройдемо по її записам


Dim rst As Dao.Recordset
Dim idx As String
Dim deltaTOP As Long
deltaTOP = 0


Set rst = CurrentDb.OpenRecordset(“select * from tmpControls order by  top_,left_”)
Do While Not rst.EOF
        idx = rst!ControlName
Set ctrl = our_section.Parent.Controls (idx) “Доводиться” через верх “звертатися …
        Select Case ctrl.Properties(“ControlType”)
            Case acTextBox
                html = text_Box(ctrl, deltaTOP)
            Case acLabel
                html = label_Box(ctrl, deltaTOP)
            Case acComboBox
                html = combo_Box(ctrl, deltaTOP)
            Case acImage
                html = image_Box(ctrl, deltaTOP)
            Case acSubform
                html = subform_BOX(ctrl, deltaTOP)
            Case acLine
                html = line_BOX(ctrl, deltaTOP)
            Case acRectangle
                html = rect_BOX(ctrl, deltaTOP)
            
        
            Case Else
“Зізнатися, мені просто поки нема чого обробляти
“Інші види контролів
“Якщо Ви іспоьзуете щось крім перерахованого –
“Вам доведеться попрограмміровать, взявши за основу
“Text_Box () і ін
                html = “”
        End Select
        output = output & html
        If (n <> 0) Then Print #n, html
        rst.MoveNext
Loop


rst.Close


“Прибутки таблицю
CurrentDb.TableDefs.Delete (“tmpControls”)
        
“Закриємо ДИВ
html = vbCrLf & “</div>” & vbCrLf
output = output & html
If (n <> 0) Then Print #n, html


section_to_HTML = our_section.Properties(“Height”) / 56.7 + deltaTOP + 2
Exit Function
oblom:
section_to_HTML = False


End Function


“—————————–
“Ну а тепер – допоміжні функції
“—————————–


“Переклад кольору в форматі Access в RGB
Function toRGB(ByVal color As Long) As String
Dim r As Long
Dim g As Long
Dim b As Long


b = color 256 256
g = (color – b * 256 * 256) 256
r = color – b * 256 * 256 – g * 256


toRGB = “#”


If (Len(Hex(r)) = 1) Then toRGB = toRGB & “0”
toRGB = toRGB & Hex(r)
If (Len(Hex(g)) = 1) Then toRGB = toRGB & “0”
toRGB = toRGB & Hex(g)
If (Len(Hex(b)) = 1) Then toRGB = toRGB & “0”
toRGB = toRGB & Hex(b)


End Function


Function text_Box(ctrl As Control, ByRef deltaTOP As Long) As String
On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Str(round(((ctrl.Properties(“Top”) / 56.7) + deltaTOP), 2))
html = html & “mm;left:”
html = html & Str(round(ctrl.Properties(“Left”) / 56.7, 2))
html = html & “mm”
html = html & “;font-size:” & ctrl.Properties(“FontSize”) & “pt”
html = html & “;font-family:” & ctrl.Properties(“FontName”)
html = html & “;color:” & toRGB(ctrl.Properties(“ForeColor”))


If (ctrl.Properties (“BackStyle”) = 1) Then “Тип фону – звичайний
    html = html & “;background-color:” & toRGB(ctrl.Properties(“BackColor”))
End If


html = html & “;text-align:”


Select Case (ctrl.Properties(“TextAlign”))
    Case 0, 1
        html = html & “left”
    Case 2
        html = html & “center”
    Case 3
        html = html & “right”
End Select


“Чи є межа?
html = html & “;border:”
If (ctrl.Properties(“BorderStyle”) = 0) Then
        html = html & “none”
Else
    html = html & ctrl.Properties(“BorderWidth”) & “px solid “
    html = html & toRGB(ctrl.Properties(“BorderColor “))
    html = html & “;padding:2px”
End If


html = html & “;width:” & Int(ctrl.Properties(“Width”) / 56.7) & “mm”
If (ctrl.Properties(“FontItalic”) = True) Then
    html = html & “;font-style:italic”
End If


If (ctrl.Properties(“FontWeight”) >= 600) Then
    html = html & “;font-weight:bold”
End If


If (ctrl.Properties(“FontUnderline”) = True) Then
    html = html & “;text-decoration:underline”
End If


“А тепер перевіримо: не розширилося чи поле
If ctrl.Properties (“CanGrow”) Then “Якщо поле може розширюватися
“Прикинемо (грубо!), наскільки поле розширилося
“Використовувані функції можна з часом покращувати
    Dim w, h As Integer
w = charWidth (ctrl) “Ширина символу
h = charHeight (ctrl) “Висота символу
    
“Скільки рядків буде в” штатному “розмірі?
    Dim rows_plan As Integer
    rows_plan = Int(ctrl.Properties(“Height”) / 56.7 / h) + 1
    “Debug.Print “rows_plan=” & rows_plan
    
“Скільки рядків буде реально? Можемо тільки гадати:
    Dim rows_real As Integer
    rows_real = Len(ctrl.Properties(“Text”)) / (Int(ctrl.Properties(“Width”) / 56.7 / w) – 3) + 1
    “Debug.Print “Len(ctrl.Properties(“”Text””))=” & Len(ctrl.Properties(“Text”)) & “, w=” & w & “, rows_real=” & rows_real
“Задамо зсув
    deltaTOP = deltaTOP + Max((rows_real – rows_plan) * h, 1)
End If


html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) + deltaTOP & “mm”
html = html & “””>”
html = html & replace(ctrl.Properties(“Text”), vbCrLf, “<br />”)
html = html & “</div>”


text_Box = html


Exit Function
oblom:
Resume Next
End Function
“Опрделяем висоту символу в мм за розміром кегля (як вміємо: ()
Function charHeight(ctrl As Control) As Integer
charHeight = Int(ctrl.Properties(“FontSize”) / 2.5)
End Function
“Опрделяем ширину символу в мм за розміром кегля (як вміємо: ()
Function charWidth(ctrl As Control) As Integer
charWidth = Int(ctrl.Properties(“FontSize”) / 3)
End Function


Function label_Box(ctrl As Control, ByRef deltaTOP As Long) As String
On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Str(round((ctrl.Properties(“Top”) / 56.7) + deltaTOP, 2))


html = html & “mm;left:”
html = html & Str(round(ctrl.Properties(“Left”) / 56.7, 2))
html = html & “mm”
html = html & “;font-size:” & ctrl.Properties(“FontSize”) & “pt”
html = html & “;font-family:” & ctrl.Properties(“FontName”)
html = html & “;color:” & toRGB(ctrl.Properties(“ForeColor”))


If (ctrl.Properties (“BackStyle”) = 1) Then “Тип фону – звичайний
    html = html & “;background-color:” & toRGB(ctrl.Properties(“BackColor”))
End If


html = html & “;text-align:”


Select Case (ctrl.Properties(“TextAlign”))
    Case 0, 1
        html = html & “left”
    Case 2
        html = html & “center”
    Case 3
        html = html & “right”


End Select


“Чи є межа?
html = html & “;border:”
If (ctrl.Properties(“BorderStyle”) = 0) Then
        html = html & “none”
Else
    html = html & ctrl.Properties(“BorderWidth”) & “px solid “
    html = html & toRGB(ctrl.Properties(“BorderColor “))
    html = html & “;padding:2px”
End If


html = html & “;width:” & Int(ctrl.Properties(“Width”) / 56.7) & “mm”
If (ctrl.Properties(“FontItalic”) = True) Then
    html = html & “;font-style:italic”
End If


If (ctrl.Properties(“FontWeight”) >= 600) Then
    html = html & “;font-weight:bold”
End If
If (ctrl.Properties(“FontUnderline”) = True) Then
    html = html & “;text-decoration:underline”
End If


html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) & “mm”
html = html & “””>”
html = html & replace(ctrl.Properties(“Caption”), vbCrLf, “<br />”)


html = html & “</div>”


label_Box = html


Exit Function
oblom:
Resume Next
End Function
Function combo_Box(ctrl As Control, ByRef deltaTOP As Long) As String
On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Str(round(((ctrl.Properties(“Top”) / 56.7) + deltaTOP), 2))
html = html & “mm;left:”
html = html & Str(round(ctrl.Properties(“Left”) / 56.7, 2))
html = html & “mm”
html = html & “;font-size:” & ctrl.Properties(“FontSize”) & “pt”
html = html & “;font-family:” & ctrl.Properties(“FontName”)
html = html & “;color:” & toRGB(ctrl.Properties(“ForeColor”))


If (ctrl.Properties (“BackStyle”) = 1) Then “Тип фону – звичайний
    html = html & “;background-color:” & toRGB(ctrl.Properties(“BackColor”))
End If


html = html & “;text-align:”


Select Case (ctrl.Properties(“TextAlign”))
    Case 0, 1
        html = html & “left”
    Case 2
        html = html & “center”
    Case 3
        html = html & “right”


End Select


“Чи є межа?
html = html & “;border:”
If (ctrl.Properties(“BorderStyle”) = 0) Then
        html = html & “none”
Else
    html = html & ctrl.Properties(“BorderWidth”) & “px solid “
    html = html & toRGB(ctrl.Properties(“BorderColor “))
End If


html = html & “;width:” & Int(ctrl.Properties(“Width”) / 56.7) & “mm”
If (ctrl.Properties(“FontItalic”) = True) Then
    html = html & “;font-style:italic”
End If


If (ctrl.Properties(“FontWeight”) >= 600) Then
    html = html & “;font-weight:bold”
End If
If (ctrl.Properties(“FontUnderline”) = True) Then
    html = html & “;text-decoration:underline”
End If


html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) & “mm”
html = html & “””>”


“Дізнаємося, що вибрано в полі
“Для цього подивимося, скільки колонок в списку і ширина яких з них не дорівнює нулю
Dim cols As Integer
cols = ctrl.Properties(“ColumnCount”)
Dim i As Integer
Dim txt, ColumnWidths, token As String
txt = “”
ColumnWidths = ctrl.Properties(“ColumnWidths”)
    “Debug.Print ” * * * “
For i = 0 To (cols – 1)
    “Debug.Print ColumnWidths
    If (InStr(1, ColumnWidths, “;”) <> 0) Then
        token = Trim(left(ColumnWidths, InStr(1, ColumnWidths, “;”) – 1))
    Else
        token = ColumnWidths
    End If
    “Debug.Print token
    If (token <> “0”) Then
        txt = ctrl.column(i, ctrl.Properties(“ListIndex”))
        Exit For
    End If
    ColumnWidths = Mid(ColumnWidths, InStr(1, ColumnWidths, “;”) + 1)
    “Debug.Print ColumnWidths
Next i
    “Debug.Print ” * * * “


html = html & txt
html = html & “</div>”


combo_Box = html


Exit Function
oblom:
Resume Next
End Function
Function image_Box(ctrl As Control, ByRef deltaTOP As Long) As String
On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Int(ctrl.Properties(“Top”) / 56.7) + deltaTOP
html = html & “mm;left:”
html = html & Int(ctrl.Properties(“Left”) / 56.7)
html = html & “mm”


“Чи є межа?
html = html & “;border:”
If (ctrl.Properties(“BorderStyle”) = 0) Then
        html = html & “none”
Else
    html = html & ctrl.Properties(“BorderWidth”) & “px solid black”
End If


html = html & “;width:” & Int(ctrl.Properties(“Width”) / 56.7) & “mm”
html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) & “mm”


html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) & “mm”
html = html & “””>”


“А тепер, власне, картинка


html = html & vbCrLf & “<img src=”””


Dim fs As Object
Set fs = CreateObject(“Scripting.FileSystemObject”)
html = html & fs.GetFileName(ctrl.Picture)
html = html & “”””


html = html & ” style=”””
html = html & “width:” & Int(ctrl.Properties(“Width”) / 56.7) & “mm”
html = html & “;height:” & Int(ctrl.Properties(“Height”) / 56.7) & “mm”
html = html & “”””


html = html & “>”
html = html & “</div>”


image_Box = html


Exit Function
oblom:
Resume Next
End Function


Function subform_BOX(ctrl As Control, ByRef deltaTOP As Long) As String
“Мої підлеглі звіти вже знають, що вони будуть підлеглими
“Тому вони на відкриття поміщають свій ХТМЛ-код в глобальну змінну subreportHTML,
“Для чого можна використовувати section_to_html без запису у файл, наприклад:
”    subreportHTML = “”
”    Call section_to_HTML(DataField, 0, 0, subreportHTML)
“Де DataField – присвоєне мною ім’я області даних (якщо підлеглий звіт складається тільки з неї)


On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Int(ctrl.Properties(“Top”) / 56.7) + deltaTOP
html = html & “mm;left:”
html = html & Int(ctrl.Properties(“Left”) / 56.7)
html = html & “mm”


“Чи є межа?
html = html & “;border:”
If (ctrl.Properties(“BorderStyle”) = 0) Then
        html = html & “none”
Else
    html = html & ctrl.Properties(“BorderWidth”) & “px solid black”
End If
html = html & “””>”
html = html & subreportHTML


html = html & “</div>”


subform_BOX = html


Exit Function
oblom:
Resume Next
End Function


Function line_BOX(ctrl As Control, ByRef deltaTOP As Long) As String


On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Int(ctrl.Properties(“Top”) / 56.7) + deltaTOP
html = html & “mm;left:”
html = html & Int(ctrl.Properties(“Left”) / 56.7)
html = html & “mm”


If (Int(ctrl.Properties(“Width”)) = 0) Then
    html = html & “;width:”
    html = html & ctrl.Properties(“BorderWidth”) + 1
    html = html & “mm”
    html = html & “;height:”
    html = html & Str(round((ctrl.Properties(“Height”) / 56.7), 2))
    html = html & “mm”
    html = html & “;border-left:” & ctrl.Properties(“BorderWidth”) & “px solid “
    html = html & toRGB(ctrl.Properties(“BorderColor”))
ElseIf (Int(ctrl.Properties(“Height”)) = 0) Then
    html = html & “;width:”
    html = html & Str(round((ctrl.Properties(“Width”) / 56.7), 2))
    html = html & “mm”
    html = html & “;height:”
    html = html & ctrl.Properties(“BorderWidth”) + 1
    html = html & “mm”
    html = html & “;border-top:” & ctrl.Properties(“BorderWidth”) & “px solid “
    html = html & toRGB(ctrl.Properties(“BorderColor”))
Else
“Сподіваюся не побачити в своїх звітах косі лінії
“Побачу – буду гіф вставляти: (
End If


html = html & “””></div>”


line_BOX = html


Exit Function
oblom:
Resume Next
End Function


Function rect_BOX(ctrl As Control, ByRef deltaTOP As Long) As String


On Error GoTo oblom
Dim html As String
html = vbCrLf & “<div style=””position:absolute;top:”
html = html & Int(ctrl.Properties(“Top”) / 56.7) + deltaTOP
html = html & “mm;left:”
html = html & Int(ctrl.Properties(“Left”) / 56.7)
html = html & “mm”


html = html & “;width:”
html = html & Str(round((ctrl.Properties(“Width”) / 56.7), 2))
html = html & “mm”


html = html & “;height:”
html = html & Str(round((ctrl.Properties(“Height”) / 56.7), 2))
html = html & “mm”


html = html & “;border:” & ctrl.Properties(“BorderWidth”) & “px solid “
html = html & toRGB(ctrl.Properties(“BorderColor”))


If (ctrl.Properties (“BackStyle”) = 1) Then “Тип фону – звичайний
    html = html & “;background-color:” & toRGB(ctrl.Properties(“BackColor”))
End If


html = html & “””></div>”


rect_BOX = html


Exit Function
oblom:
Resume Next
End Function


“—————————
“3. Як це все використовувати
“—————————


“Думаю, до кінця цього есе Ви вже забули, з чого ми почали 🙂


“Нагадаю: ми хотіли звіт в HTML перегнати


“- = Роби-раз = -.
“У модулі звіту, який хочемо експортнуть в HTML, длаем дві глобальні змінні –
“1. Дескриптор файлу
“2. Відступ следующго ДИВА.


“Наприклад:
“Dim n As Long
“Dim nextTOP As Long

“- = Роби-два = -.
“На подію ВІДКРИТТЯ звіту, який хочемо експортнуть в HTML,
“Вішаємо щось на зразок


“n = FreeFile
“Open “c: est.html” For Output As #n
“Print #n, “<!DOCTYPE HTML PUBLIC “”-//W3C//DTD HTML 4.0 Transitional//EN””>”
“Print #n, “<html><head></head><body>”
“nextTOP=0


“- = Роби-три = -.
“На подію ФОРМАТУВАННЯ всіх областей звіту вішаєте
“nextTOP = nextTOP+section_to_HTML(reportTitle, n, nextTOP)


“- = Роби-чотири = -.


“Подія ФОРМАТУВАННЯ примітки звіту закінчите так:
“Print #n, “</body></html>”
“Close #n


“—————————
“4. Ну і що в результаті?
“—————————


“У підсумку виходить файл на диску, який містить HTML-код звіту. Проблем аж дві:


“1. Підігнані впритул елементи звіту в HTML іноді поділяються маленькими,
“Але помітними щілинами. ЛІКУЄТЬСЯ коригуванням макета – невеликим (не більше 0.5 мм)” наезжаніем “
“Правою області на ліву (потім ліву область потрібно винести на перший план)
“2. Трапляється, що діви різних областей звіту трохи налазять один на одного.
“ЛІКУЄТЬСЯ коригуванням третього параметра функції section_to_HTML для нижньої області,
“Відповідає за відступ області від верхнього краю


“Всі проблеми лікуються в гіршому випадку кількома хвилинами роботи з HTML-кодом.

“Але зате вийшов результат можна швидко і легко послати по e-mail.
“Або підготувати HTML-сторінку для викладання на сайт

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*