Choć kodu, który jest poniżej nigdy nie użyłem w finalnej aplikacji to w testach już tak – spędzając trochę czasu nad nim. Kod wydaje się dość fajny, użyto tagów HTML aby utworzyć plik HTM otwierany w przeglądarce internetowej.
Utworzenie pliku w formacie HTM gwarantuje nam, że po jego otwarciu będzie (powinien) zachowywać się tak samo na każdej stacji roboczej. Plik HTM tworzyłem w momencie, gdy nie było w Excelu narzędzia zapisywania zawartości do pliku PDF.
Z poniższych źródeł skorzystałem, aby utworzyć plik HTM:
1. Tworzenie pliku HTM z danych w arkuszu
2. Filtr rozszerzeń przy zapisaniu plików
3. Różne rodzaje tabel w CSS
4. Rozmiar czcionki w CSS
5. Polskie znaki w Firefox
Do testów trzeba dodać jakieś dane w aktywnym arkuszu, najlepiej tak jak poniżej:
Jak utworzyć plik HTM:
' Source:
' Tworzenie pliku HTM z danych w arkuszu
' http://www.meadinkent.co.uk/xlhtmltable.htm
' Filtr rozszerzeń przy zapisaniu plików
' http://software-solutions-online.com/2014/03/13/excel-vba-save-file-dialog-getsaveasfilename/
' Różne rodzaje tabel w css
' http://stackoverflow.com/questions/7992198/html-how-to-make-2-tables-with-different-css
' Rozmiar czcionki w css
' http://www.w3schools.com/tags/att_font_size.asp
' Polskie znaki w Firefox
' http://forums.phpfreaks.com/topic/132413-polish-characters-dont-display-properly/
Sub HTM_Page_Creation()
Dim TempStr
Dim PageName As String
Dim MyFormats As Variant
Dim FirstRow, LastRow, FirstCol, LastCol, MyRow, MyCol As Integer
' ----------------------------------
' LOKALIZACJA PLIKU HTM
PageName = Application.GetSaveAsFilename("HTM_File_Name", "Plik HTM (*.htm), *.htm", 1, "Zapisz zamówienie")
' Sprawdzanie czy user czasem nie nacisął ANULUJ
If PageName = "False" Then
MsgBox "Zaniechano zapisu.", vbOKOnly + vbInformation, "POTWIERDZENIE..."
Exit Sub
End If
' ----------------------------------
' DEFINIOWANIE ZMIENNYCH
' MyFormats is an array which can contain formats for numbersand dates. Add one element for each table column.
MyFormats = Array("#", "dd mmm yy", "# ##0 pln", "0%")
' Sztywne deklaracje zakresu tabeli w htm
FirstRow = 1
LastRow = 6
FirstCol = 1
LastCol = 4
' ----------------------------------
' SPRAWDZANIE POPRAWNOŚCI DANYCH (choć przyznaje, że nie wiem jak to działa)
'Jeżeli bład to przerwanie makra
'If UBound(MyFormats2) < (LastCol - FirstCol) Then
' MsgBox "Brak danych w arkuszu. Zatrzymanie wykonania kodu.", vbOKOnly + vbCritical, "TWORZENIE PLIKU HTM..."
' Exit Sub
'End If
' ----------------------------------
' TWORZENIE PLIKU HTM
Open PageName For Output As #1
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>COMPANY SALE RAPORT</title>" ' widoczny m.in. w zakładce w przegladarce
Print #1, "<meta http-equiv='content-type' content='text/html;charset=windows-1250' />" ' polskie znaki w FireFox
Print #1, "<style type='text/css'>"
Print #1, "body {font-family: Arial, Helvetica; font-size: 11pt; margin-left: 10; margin-right: 10}"
Print #1, "td.td1 {padding: 1pt 3pt 2pt 3pt; border-style: solid; border-width: 1; border-color: #0F5BB9; font-size: 11pt}"
Print #1, "table.table1 {border-collapse: collapse; border-width: 1 ; border-style: solid; border-color: #0F5BB9 }"
Print #1, "p.p1 {font-size: 8pt}"
Print #1, "</style>"
Print #1, "</head>"
Print #1, "<body>"
Print #1, "<h1>MÓJ TYTUŁ STRONY</h1>"
Print #1, "<p></p>"
Print #1, "<table class='table1'>"
Print #1, "<p></p>"
' Fizyczne dodawanie wartości z arkusza do pliku HTM
For MyRow = FirstRow To LastRow
Print #1, "<tr>"
For MyCol = FirstCol To LastCol
If MyRow = 1 Then
TempStr = Cells(MyRow, MyCol).Value
TempStr = "<b>" & TempStr & "</b>"
TempStr = "<td class='td1'; align='center'; bgcolor='#58FAF4'>" & TempStr & "</td>"
Else
If IsNumeric(Cells(MyRow, MyCol).Value) = True Then
TempStr = Format(Cells(MyRow, MyCol).Value, MyFormats(MyCol - FirstCol))
TempStr = "<td class='td1'; align='right'>" & TempStr & "</td>"
Else
TempStr = Cells(MyRow, MyCol).Value
TempStr = "<td class='td1'; align='left'>" & TempStr & "</td>"
End If
End If
Print #1, TempStr
Next MyCol
Print #1, "</tr>"
Next MyRow
Print #1, "</table>"
' Finalizacja pliku HTM
Print #1, "<p></p>"
Print #1, "<p class='p1'>Można przeszukiwać dane używając [CTRL]+'F'. Naciśnij [Home], aby"
Print #1, "wrócić na górę strony. Dane mogą być kopiowane do Excela</p>"
Print #1, "<hr>"
Print #1, "<p><small>Raport utworzono dnia: " & Format(Date, "dd-mm-yyyy") & " | <a href='http://www.meadinkent.co.uk/'>Plik utworzono dzięki meadinkent</a></small></p>"
Print #1, "<p></p>"
Print #1, "<p><img src='Można dodać jakieś zdjecie'></p>"
Print #1, "</body>"
Print #1, "</html>"
Close #1
MsgBox "Done"
End Sub