Option Explicit
Option Base 1

Sub CellToHTMLConvert()
    
    '------------------------------------------------------------------------------
    ' I͈͂ html^O ɕϊă֏o͂
    '  1) Z͈̑؏o͂Ȃ
    '  2) width(%)̓Z玩vZiTrueFvZAFalseFvZȂj
    '  3) height͏o͂Ȃ
    ' [⑫]
    ' Eւ̎󂯓n͕ϐNbv{[hoR
    '  if[^܂ɑ̂͐łȂ̂߁A1000 ZȏIĂƒfj
    '------------------------------------------------------------------------------
    
    'width Z玩vZ邩 (True:vZAFalseFvZȂj
    Const blnWidthAutoCal As Boolean = True
    
    Dim MsgRtn As Long          'msgbox̖߂l
    Dim wkRng As Range          'I͈͋L
    
    Dim strText As Variant      'Nbv{[hɓnf[^
    
    Dim SumColWidth As Single   '
    Dim ColWidth                '񕝂̃p[Ze[Wpz
    Dim i As Long               'colWidth̓Ypϐ
    
    Dim r As Long, c As Long
    Dim rowSt As Long, rowEd As Long, colSt As Long, colEd As Long
    
    '^O
    ' Œ蕪
    Const strTagTableTbodySt As String = "<table style=""border-collapse: collapse; width: 100%;"">" & vbCrLf & "<tbody>" & vbCrLf
    Const strTagTrSt As String = "<tr>" & vbCrLf
    Const strTagTdEd As String = "</td>" & vbCrLf
    Const strTagTrEd As String = "</tr>" & vbCrLf
    Const strTagTableTbodyEd As String = "</tbody>" & vbCrLf & "</table>" & vbCrLf
    ' ϕ
    Dim strTagTdSt1 As String
    Dim strTagTdSt2 As String
    'IvVɂtd^OύX
    If blnWidthAutoCal = True Then
        strTagTdSt1 = "<td style=""width: "
        strTagTdSt2 = "%;"">"
    Else
        strTagTdSt1 = "<td"
        strTagTdSt2 = ">"
    End If
    
    'I͈͂ɒl邩mFilȂΏIj
    If WorksheetFunction.CountA(Selection) = 0 Then
        Exit Sub
    End If
    
    'I͈͂L
    Set wkRng = Selection
    
    If Selection.Count > 100 Then
        MsgRtn = MsgBox("Z100ȏIĂ܂As܂H" & vbCrLf & vbCrLf, _
                    vbOKCancel + vbInformation + vbDefaultButton2, Title:="mF")
        If MsgRtn = vbCancel Then Exit Sub
    ElseIf Selection.Count > 1000 Then
        MsgRtn = MsgBox("Z1000ȏIĂ̂ŁAf܂B" & vbCrLf & vbCrLf & _
                    vbExclamation + vbInformation, Title:="f")
        Exit Sub
    End If
    
    'ƍs擾
    rowSt = Selection(1).Row
    rowEd = Selection(Selection.Count).Row
    colSt = Selection(1).Column
    colEd = Selection(Selection.Count).Column
    
    'td^OpWidthi[ϐiIvVFalse͋󔒁j
    ReDim ColWidth(Columns.Count)
    'td^OpWidthvZ
    If blnWidthAutoCal = True Then
        '񕝂̑v擾
        For c = colSt To colEd
            SumColWidth = SumColWidth + Columns(c).ColumnWidth
        Next c
        '񕝂̃p[Ze[WvZ
        i = 0
        For c = colSt To colEd
            i = i + 1
            '_4܂ (6܂łƂĂ艺͐؂̂āAp[Ze[Wϊ100j
            ColWidth(i) = WorksheetFunction.RoundDown(Columns(c).ColumnWidth / SumColWidth, 6) * 100
        Next c
    End If
    
    'table^OAtbody^O
    strText = strTagTableTbodySt
    'Zetr/td^OƂƂɏo
    For r = rowSt To rowEd
        'tr^O
        strText = strText & strTagTrSt
        i = 0
        For c = colSt To colEd
            i = i + 1
            'td^OƂƂɃZeo
            strText = strText & strTagTdSt1 & ColWidth(i) & strTagTdSt2 & Cells(r, c).Text & strTagTdEd
        Next c
        'tr^Oij
        strText = strText & strTagTrEd
    Next r
    'table^OAtbody^Oij
    strText = strText & strTagTableTbodyEd
    
    'Nbv{[hɊi[
    With CreateObject("Forms.TextBox.1")
      .MultiLine = True
      .Text = strText
      .SelStart = 0
      .SelLength = .TextLength
      .Copy
    End With
  
    '҂iǂtȂꍇAj
    Application.Wait Now() + TimeValue("00:00:03")
    'N
    Shell "notepad", 1
    
    '҂iǂtȂꍇAj
    Application.Wait Now() + TimeValue("00:00:02")
    'ɓ\t
    SendKeys "^V", True
    
    '̑I͈͂I
    wkRng.Select

End Sub
