Jak zrobić swoją stronę internetową.   strona główna:
A po co ten Excel ;-)
 
Nie będzie to przepis na super wypasioną stronkę internetowa, ale taką tematyczną stronkę, na której będzie położony nacisk na   
treść, przykłady, ciekawostki... No powiedźmy taka jak ta :-D No dobra - dokładnie ta! ;-)  
 
Przez wzgląd na celowość walki ze świadomością społeczną w tematyce aPoCoTenExcel tak naprawdę jest i co można w nim zrobić   
zaświtał mi pomysł stworzenia właśnie takiej stronki. Na moje pytanie na SB excelforum.pl dot. tematyki stron internetowych i tego   
z czego to powstaje, co trzeba na ten temat wiedzieć i w ogóle "z czym to się je" dowiedziałem się że HTMP, a może i PHP... Ho.ho   
:-D a Excel to nie wystarczy?? Zamierzam udowodnić że TAK :-)  
 
Skoro można zapisać plik Excela jako stronę sieci Web to utworzenie strony nie powinno stanowić   
problemu. Stworzę szablon i będę się go trzymał resztę załatwią procedury VBA.  
 
 
Sub CreateHTMFileFromExcelWorksheet(wks As Excel.Worksheet, _  
                                    strHTMFileFullName As String, _  
                                    Optional bUsuwaćObrazy As Boolean = False)  
    '------------na podstawie: Function RangetoHTML-----------  
    '-----http://www.rondebruin.nl/mail/folder3/mail4.htm-----  
    '-----Mail Range or Selection in the body of the mail-----  
    '----------------Ron de Bruin 28-Oct-2006-----------------  
 
    If Not strHTMFileFullName Like "*.htm" Then  
        strHTMFileFullName = strHTMFileFullName & ".htm"  
    End If  
      
    With wks  
        If bUsuwaćObrazy Then  
            On Error Resume Next  
            .DrawingObjects.Visible = True  
            .DrawingObjects.Delete  
            On Error GoTo 0  
        End If  
    End With  
    With wks.Parent  
        With .PublishObjects.Add(SourceType:=xlSourceRange, _  
                                 Filename:=strHTMFileFullName, _  
                                 Sheet:=wks.Name, _  
                                 Source:=wks.UsedRange.Address, _  
                                 HtmlType:=xlHtmlStatic)  
            .Publish True  
        End With  
    End With  
 
End Sub  
 
Jak widać do utworzenia strony posłużę się odrobinę przerobioną procedurą Ron'a de Bruin tworzącą treść maila. Procedura ma za   
zadanie zapisać UsedRange arkusza jako stronę htm i robi co do niej należy.  
    Jednak co zrobić żeby ww procedura była tak fajnie sformatowana? No jak to jak: zaznaczyć zakres procedury, z paska   
formatowanie - czcionka: Courier New. Zaznaczasz zakres słowa Sub i czcionka na niebiesko, ... Hehe ;-) :-P Tym sposobem to   
jedna strona powstawałaby w miesiąc, a ludzie zgłaszaliby poprawki które zauważyli. Ale od czego jest VBA :-)  
Napiszmy nasz konwerter tekstu zakresu na formatowanie z Edytora VBA. Co nam jest potrzebne: spis KeyWords i jakiś pomysł jak    Słowa Kluczowe
wygrzebywać je z tekstu. Spis KeyWords znalazłem w VBMagazien choć wcześniej wypisywałem to co mogłem znaleźć w swoich    VBMagazine
przykładowych procedurach. Procedura wygląda tak:  
 
Private Sub EditFormat(ParamArray arrRng() As Variant)  
    On Error GoTo EditFormat_Error  
    Dim rng As Variant  
      
    Dim objRegExp As Object 'VBScript_RegExp_55.RegExp  
    Dim objMatchCollection As Object 'VBScript_RegExp_55.MatchCollection  
    Dim objMatch As Object 'VBScript_RegExp_55.Match  
      
    Dim arrKeyWords As Variant, iArr As Integer  
    Dim kom As Excel.Range, iChr As Integer  
      
    Const xlKeyWordsColorIndex As Variant = 55  
    Const xlCommentColorIndex As Variant = 10  
      
    'lista: Słowa kluczowe  
    'http://www.vb4all.pl/vbm/czytam/vbm11/bez_muzyki.htm  
      
    arrKeyWords = Array("Option", "Explicit", "Base", "Module", _  
                        "Compare", "Text", "Binary", _  
                        "Private", "Public", "Declare", "Lib", "Alias", _  
                        "Type", "Enum", _  
                        "Sub", "Function", "End", "Exit", "Optional", "ParamArray", "Call", "Stop", _  
                        "Dim", "Const", "Static", "Global", "Shared", _  
                        "ByVal", "ByRef", _  
                        "As", "Boolean", "Byte", "Currency", "Date", "Single", "Double", "Integer", _  
                        "Long", "Variant", "Object", "String", "Any", _  
                        "CBool", "CByte", "CCur", "CDate", "CDbl", "CDec", "CInt", "CLng", "CSng", _  
                        "CStr", "CVar", _  
                        "Set", "New", "Nothing", "Null", _  
                        "Property", "Let", "Get", _  
                        "If", "Else", "ElseIf", "Then", _  
                        "And", "Or", "Xor", "Eqv", "Not", "Like", "Mod", _  
                        "For", "To", "Step", "Each", "In", "Next", _  
                        "Open", "Input", "Output", "Random", "Append", "Access", "Read", "Write", "Lock", _  
                        "Print", "Put", "Close", _  
                        "Do", "Until", "While", "Loop", "Wend", _  
                        "Select", "Case", "With", _  
                        "Redim", "UBound", "LBound", _  
                        "On Error", "Resume", "GoTo 0", "GoTo", _  
                        "True", "False", _  
                        "Debug", _  
                        "CBool", "Empty", "AddressOf")  
        
    Set objRegExp = CreateObject("VBScript.RegExp")  
    With objRegExp  
        .IgnoreCase = False  
        .Global = True  
    End With  
      
    For Each rng In arrRng  
        With rng.Font  
            .ColorIndex = 0  
            .Size = 10  
            .Name = "Courier New"  
        End With  
        For Each kom In rng  
            If Not IsEmpty(kom) Then  
                  
                If Left(Trim(Replace(kom.Value, Chr(160), "")), 1) = "'" Then  
                    kom.Font.ColorIndex = xlCommentColorIndex  
                Else  
                    For iArr = LBound(arrKeyWords) To UBound(arrKeyWords)  
                        With objRegExp  
                            .Pattern = "(\W{1}|^)(" & arrKeyWords(iArr) & ")(\W{1}|$)"  
                            If .test(kom.Value) Then  
                                Set objMatchCollection = .Execute(kom.Value)  
                                For Each objMatch In objMatchCollection  
                                    With kom.Characters(Start:=objMatch.FirstIndex + 1, _  
                                                        Length:=Len(arrKeyWords(iArr)) + 1).Font  
                                        .ColorIndex = xlKeyWordsColorIndex  
                                    End With  
                                Next  
                            End If  
                        End With  
                    Next  
                End If  
            End If  
        Next  
    Next  
      
EditFormat_Exit:  
    Set objRegExp = Nothing  
    Set objMatchCollection = Nothing  
    Exit Sub  
 
EditFormat_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - EdiFor"  
    Resume EditFormat_Exit  
 
End Sub  
 
A więc w arrKeyWords podajemy kolejne słowa kluczowe, a następnie w pętli przeglądnie każdą linię, i w każdej linii wszystkie   
wystąpienia każdego z elementów arrKeyWords. Wg mnie RegExp nadaje się tu po prostu idealnie. Jeżeli Test zwróci True utworzona   
zostanie MatchCollection. A jaki fragment linii zmienić? Od objMatch.FirstIndex o długości Len(arrKeyWords(iArr)). Przesunięcia   
wynikają z Pattern, gdyż określony jest na znak przed i po słowie klucz. Ma to swoje minusy, ale procedura zachowuje elegancję, a   
że to przykład w zupełności mi wystarcza że robi za mnie 99% roboty. No ale jak wygląda. Procedura posiada arg. arrRng() więc z   
założenia może przyjmować tablicę zakresów - w miarę pisania wypisywałem w procedurze startowej kolejne adresy. Pierwsza stronka   
tak powstała - następne odbywały się przez wywołanie EditFormat Selection. Nie  - wcale nie lenistwo :-P  
Po prostu efekt widać od razu, a tak jak dołożyłem wiersz to mi się już nie chciało adresów edytować, choć funkcjonalność została.  
 
 
i przykłądowa procedura startowa  
 
Sub UtworzStrone()  
    Dim wks As Excel.Worksheet  
    'Dim rng As Excel.Range  
      
    Application.ScreenUpdating = False  
      
    Set wks = ThisWorkbook.Worksheets("Arkusz1")  
    With wks  
        'Set rng = .UsedRange  
        EditFormat Selection  
        'EditFormat .[B22:B85], .[B110:B124], _  
                    .[B130:B137], .[B143:B154], _  
                    .[B160:B165], [B171:B174]  
    End With  
      
    CreateHTMFileFromExcelWorksheet wks, ThisWorkbook.Path & "\StronaInternetowa.htm"  
      
    Application.ScreenUpdating = True  
      
    Set wks = Nothing  
    'Set rng = Nothing  
 
End Sub  
 
No i mamy stronkę. :-) Pół godziny roboty  
HTML, PHP, CSS ... - po co? Wystarczy Excel i VBA :-)