Macro om snel Excel om te zetten naar een Tabel

[Withaar]

Excel naar HTML tabel / Excel to HTML table

Voor zo ver ik weet is er geen eenvoudige methode om (een deel van) een excel pagina op het forum te zetten.

Je kunt de 'Table' code gebruiken in je bericht maar dat is erg veel hand werk.

Ik heb een macro gemaakt die snel een geselecteerd deel op een excel blad omzet naar html code die je op Helpmij in je bericht kunt gebruiken.

De macro houd geen rekening met kleur of andere cel opmaak e.d., maar voel je vrij om de code aan te passen/te verbeteren.

Public filename As String
Sub Maak_HTML_Table()
Application.ScreenUpdating = False ' Antiflikker
Application.Calculation = xlCalculationManual 'Even geen autoca***atie tijdens het deze macro...
' Oké, om welke gebied gaat het, je moet dus wel een gebied hebben geselecteerd....
Dim Gebied As Range
Set Gebied = Selection
Dim Inhoud, nl, B, nB, C, nC, v As String
Dim K As Integer
Inhoud = "[Table]"
nl = "<br>"
B = "[b]"
nB = "[/b]"
C = "[center]"
nC = "[/center]"
v = " | " ' scheiding teken tussen cellen binnen een HTML table
'
Dim Rij_E, Rij_L, Kolom_E, Kolom_L As Integer 'Eerste en laatste
Rij_E = Gebied.Row
Rij_L = Selection.Rows.Count + Rij_E
Kolom_E = Gebied.Column
Kolom_L = Selection.Columns.Count + Kolom_E
' optie menu
Dim Keuze As Integer
5:
On Error Resume Next
Application.DisplayAlerts = False
Keuze = Application.InputBox(Default:="3", Prompt:="Kies de gewenste uitvoer:" & vbCr & "1. Waarden " & vbCr & "2. Formules" & vbCr & "3. Beide" & vbCr & vbCr & "Let op: " & vbCr & vbCr & "Na je keuze wordt Internet Explorer gestart en de code getoond," & vbCr & "kopieer en plak de inhoud van de pagina in je bericht." & vbCr & vbCr & " ", Title:="Kies Output vorm", Type:=1)
On Error GoTo 0
Application.DisplayAlerts = True
If Keuze < 1 Or Keuze > 3 Then GoTo 40 ' Tja geen geldige keuze gemaakt...
' locatie waar het tijdelijke bestand weggeschreven gaat worden
filename = "c:\temp\Excel2Table.htm"
Open filename For Output As 1
10:
If Keuze = 2 Then GoTo 20
' kolom letters
For K = Kolom_E To Kolom_L
Inhoud = Inhoud & v & C & B & Left(Selection.Cells(1, K).AddressLocal(0, 0), Len(Selection.Cells(1, K).AddressLocal(0, 0)) - 1) & nB & nC
Next K
Print #1, Inhoud & v
Print #1, nl
'Rijen en inhoud
Dim x As Integer ' = rij
Dim y As Integer ' = kolom
    For x = Rij_E To Rij_L
        Inhoud = "|"
        For y = Kolom_E To Kolom_L
            Inhoud = Inhoud & " " & Cells(x, y).Value & " " & v
        Next y
Print #1, x & Inhoud & nl
Next x
Print #1, "[/table]" & nl
If Keuze = 1 Then GoTo 30
20:
If Keuze = 3 Then Inhoud = nl & "[Table]" Else Inhoud = "[Table]"
For K = Kolom_E To Kolom_L
    Inhoud = Inhoud & v & C & B & Left(Selection.Cells(1, K).AddressLocal(0, 0), Len(Selection.Cells(1, K).AddressLocal(0, 0)) - 1) & nB & nC
Next K
Print #1, Inhoud & v
Print #1, nl
    For x = Rij_E To Rij_L
        Inhoud = "|"
        For y = Kolom_E To Kolom_L
            Inhoud = Inhoud & " " & Cells(x, y).Formula & " " & v
        Next y
Print #1, x & Inhoud & nl
Next x
Print #1, "[/table]" & nl
30:
Close #1
' weg schrijven naar html bestand
MsgBox "Internet Explorer wordt gestart, de aangemaakte internet pagina: " & filename & " wordt automatisch getoond"
' Outlook starten en bestand tonen
Dim RC As Long
RC = Shell("Explorer " & filename, 1)
' Alles weer even netjes aan zetten
40:
Application.Calculation = xlCalculationAutomatic 'Autoca***atie weer aan
Application.ScreenUpdating = True
End Sub

* Ivm de table tags in de macro code kon deze niet tussen Code tages gezet worden.
Begin met tekst selecteren tussen de 1 en de P van Public, de regel nummers worden dan niet mee genomen of kopieer e.a. uit de txt bijlage.

Een voorbeeld gemaakt met optie 3.

[table="width: 500, class: dotted"][tr][td][/td][td]

A​

[/td][td]

B​

[/td][td]

C​

[/td][td]

D​

[/td][/tr]
[tr][td]1[/td][td] [/td][td] Amerikaanse week nummer [/td][td] Europese week nummer [/td][td] [/td][/tr]
[tr][td]2[/td][td] 30-12-2009 [/td][td] 53 [/td][td] 53 [/td][td] [/td][/tr]
[tr][td]3[/td][td] 31-12-2009 [/td][td] 53 [/td][td] 53 [/td][td] [/td][/tr]
[tr][td]4[/td][td] 1-1-2010 [/td][td] 1 [/td][td] 53 [/td][td] [/td][/tr]
[tr][td]5[/td][td] 2-1-2010 [/td][td] 1 [/td][td] 53 [/td][td] [/td][/tr]
[tr][td]6[/td][td] 3-1-2010 [/td][td] 2 [/td][td] 53 [/td][td] [/td][/tr]
[tr][td]7[/td][td] 4-1-2010 [/td][td] 2 [/td][td] 1 [/td][td] [/td][/tr]
[tr][td]8[/td][td] 5-1-2010 [/td][td] 2 [/td][td] 1 [/td][td] [/td][/tr]
[tr][td]9[/td][td] [/td][td] [/td][td] [/td][td] [/td][/tr]
[tr][td]10[/td][td] 30-12-2010 [/td][td] 53 [/td][td] 52 [/td][td] [/td][/tr]
[tr][td]11[/td][td] 31-12-2010 [/td][td] 53 [/td][td] 52 [/td][td] [/td][/tr]
[tr][td]12[/td][td] 1-1-2011 [/td][td] 1 [/td][td] 52 [/td][td] [/td][/tr]
[tr][td]13[/td][td] 2-1-2011 [/td][td] 2 [/td][td] 52 [/td][td] [/td][/tr]
[tr][td]14[/td][td] 3-1-2011 [/td][td] 2 [/td][td] 1 [/td][td] [/td][/tr]
[tr][td]15[/td][td] 4-1-2011 [/td][td] 2 [/td][td] 1 [/td][td] [/td][/tr]
[tr][td]16[/td][td] [/td][td] [/td][td] [/td][td] [/td][/tr]
[/table]

[table="width: 500, class: dotted"][tr][td][/td][td]

A​

[/td][td]

B​

[/td][td]

C​

[/td][td]

D​

[/td][/tr]
[tr][td]1[/td][td] [/td][td] Amerikaanse week nummer [/td][td] Europese week nummer [/td][td] [/td][/tr]
[tr][td]2[/td][td] 40177 [/td][td] =WEEKNUM(A2) [/td][td] =1+INT((A2-DATE(YEAR(A2+4-WEEKDAY(A2+6)),1,5)+WEEKDAY(DATE(YEAR(A2+4-WEEKDAY(A2+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]3[/td][td] =A2+1 [/td][td] =WEEKNUM(A3) [/td][td] =1+INT((A3-DATE(YEAR(A3+4-WEEKDAY(A3+6)),1,5)+WEEKDAY(DATE(YEAR(A3+4-WEEKDAY(A3+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]4[/td][td] =A3+1 [/td][td] =WEEKNUM(A4) [/td][td] =1+INT((A4-DATE(YEAR(A4+4-WEEKDAY(A4+6)),1,5)+WEEKDAY(DATE(YEAR(A4+4-WEEKDAY(A4+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]5[/td][td] =A4+1 [/td][td] =WEEKNUM(A5) [/td][td] =1+INT((A5-DATE(YEAR(A5+4-WEEKDAY(A5+6)),1,5)+WEEKDAY(DATE(YEAR(A5+4-WEEKDAY(A5+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]6[/td][td] =A5+1 [/td][td] =WEEKNUM(A6) [/td][td] =1+INT((A6-DATE(YEAR(A6+4-WEEKDAY(A6+6)),1,5)+WEEKDAY(DATE(YEAR(A6+4-WEEKDAY(A6+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]7[/td][td] =A6+1 [/td][td] =WEEKNUM(A7) [/td][td] =1+INT((A7-DATE(YEAR(A7+4-WEEKDAY(A7+6)),1,5)+WEEKDAY(DATE(YEAR(A7+4-WEEKDAY(A7+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]8[/td][td] =A7+1 [/td][td] =WEEKNUM(A8) [/td][td] =1+INT((A8-DATE(YEAR(A8+4-WEEKDAY(A8+6)),1,5)+WEEKDAY(DATE(YEAR(A8+4-WEEKDAY(A8+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]9[/td][td] [/td][td] [/td][td] [/td][td] [/td][/tr]
[tr][td]10[/td][td] 40542 [/td][td] =WEEKNUM(A10) [/td][td] =1+INT((A10-DATE(YEAR(A10+4-WEEKDAY(A10+6)),1,5)+WEEKDAY(DATE(YEAR(A10+4-WEEKDAY(A10+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]11[/td][td] =A10+1 [/td][td] =WEEKNUM(A11) [/td][td] =1+INT((A11-DATE(YEAR(A11+4-WEEKDAY(A11+6)),1,5)+WEEKDAY(DATE(YEAR(A11+4-WEEKDAY(A11+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]12[/td][td] =A11+1 [/td][td] =WEEKNUM(A12) [/td][td] =1+INT((A12-DATE(YEAR(A12+4-WEEKDAY(A12+6)),1,5)+WEEKDAY(DATE(YEAR(A12+4-WEEKDAY(A12+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]13[/td][td] =A12+1 [/td][td] =WEEKNUM(A13) [/td][td] =1+INT((A13-DATE(YEAR(A13+4-WEEKDAY(A13+6)),1,5)+WEEKDAY(DATE(YEAR(A13+4-WEEKDAY(A13+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]14[/td][td] =A13+1 [/td][td] =WEEKNUM(A14) [/td][td] =1+INT((A14-DATE(YEAR(A14+4-WEEKDAY(A14+6)),1,5)+WEEKDAY(DATE(YEAR(A14+4-WEEKDAY(A14+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]15[/td][td] =A14+1 [/td][td] =WEEKNUM(A15) [/td][td] =1+INT((A15-DATE(YEAR(A15+4-WEEKDAY(A15+6)),1,5)+WEEKDAY(DATE(YEAR(A15+4-WEEKDAY(A15+6)),1,3)))/7) [/td][td] [/td][/tr]
[tr][td]16[/td][td] [/td][td] [/td][td] [/td][/tr]
[/table]

Meer over weeknummers: http://nl.wikipedia.org/wiki/Weeknummer