#はじめに
新型コロナウィルス対策として人と人の接触を避けねばなりません。しかしながら在宅ワークが不可能で通勤電車やバスに乗らなくてはならないケースがあると思います。このようなケースをどうしたら減らせるでしょうか？

推測ではありますが、いまだに神エクセル(紙エクセル、ネ申エクセルとも)を使ったオフライン業務が、在宅ワークを不可能にしている理由の1つになっているのではないでしょうか？

この記事では、神エクセルシートをhtml形式に変換するVBAコードを記述します。プログラミンングリテラシーを要せずに作成した神エクセルを、html形式に変換できます。変換後は、神エクセルシートに変わってブラウザー上のフォームで入力することができるようになります。ただし入力されたデータの処理については別途記述が必要です。

この記事の内容が在宅ワーク率を少しでも向上できれば幸いです。もし皆様の周りで神エクセルが使用されているなら、ウェブ化できるよ！と声をあげてみてはいかがでしょうか？


Sub excellToHtml()
'
' このマクロの使い方
'html形式に変換したい部分を選択してからマクロを実行してください。
'出力ファイルのエンコーディングはShift-JISです。
'ユーザーの入力を想定しているセルには$hogeなど、$から始まる名前をつけます。この名前はinputタグのname属性の値としてセットされます。
'作者 @yoho at Qiita
'2020年4月10日

Dim doubleQuate As String
doubleQuate = """"
Dim buf As String
buf = "<div class=""clearfix"">" & vbCrLf
For Row = Selection(1).Row To Selection(Selection.Count).Row
    For Column = Selection(1).Column To Selection(Selection.Count).Column
        With Cells(Row, Column).MergeArea
            xxx = Cells(Row, Column).MergeArea
            If .Row = Row And .Column = Column Then
                Font = Cells(Row, Column).Font.Name
                Size = Cells(Row, Column).Font.Size
                Size2 = Application.StandardFontSize
                If IsNull(Size) Then '複数のサイズがあるとNULLになってしまう。
                    Size = Size2
                End If
                '$で始まる値が入っていたら、データ入力用のセルと判断。nameを$以降の文字列とする。
                
                If InStr(Cells(Row, Column).Value, "$") = 1 Then
                    buf = buf & "<div class = 'inputCell' "
                Else
                    buf = buf & "<div class = 'flexbox' "
                End If
           
                buf = buf & "style=""font-size: " & Size & "px; font-family:'" & Font & "'; top:" & .Top & "px; left:" & .Left & "px; width:" & .Width & "px;height:" & .Height & "px;"
                
                If Cells(Row, Column).HorizontalAlignment = -4108 Then '-4108なら中央揃え
                    buf = buf & "justify-content: center;"
                End If
                
                Set border_top = .Borders(xlEdgeTop) '上のボーダー
                Set border_bottom = .Borders(xlEdgeBottom) '下のボーダー
                Set border_left = .Borders(xlEdgeLeft) '左のボーダー
                Set border_right = .Borders(xlEdgeRight) '右のボーダー
                'ボーダースタイル
                '-4138　    なし
                '1                  実線
                '線のWeight
                '1              極細
                '2              細
                '-4138      中
                '4              太
                
                'ボーダーの出力(上)
                If border_top.LineStyle = 1 Then
                    Select Case border_top.Weight
                        Case 1
                            buf = buf & "border-top-width:0.25px;"
                        Case 2
                            buf = buf & "border-top-width:0.5px;"
                        Case -4138
                            buf = buf & "border-top-width:1.0px;"
                        Case 4
                            buf = buf & "border-top-width:2px;"
                    End Select
                Else
                    buf = buf & "border-top-style: dotted;"
                End If
                'ボーダーの出力(左)
                If border_left.LineStyle = 1 Then
                    Select Case border_left.Weight
                        Case 1
                            buf = buf & "border-left-width:0.25px;"
                        Case 2
                            buf = buf & "border-left-width:0.5px;"
                        Case -4138
                            buf = buf & "border-left-width:1.0px;"
                        Case 4
                            buf = buf & "border-left-width:2px;"
                    End Select
                Else
                    buf = buf & "border-left-style: dotted;"
                End If
                'ボーダーの出力(右)
                If border_right.LineStyle = 1 Then
                    Select Case border_right.Weight
                        Case 1
                            buf = buf & "border-right-width:0.25px;"
                        Case 2
                            buf = buf & "border-right-width:0.5px;"
                        Case -4138
                            buf = buf & "border-right-width:1.0px;"
                        Case 4
                            buf = buf & "border-right-width:2px;"
                    End Select
                Else
                    buf = buf & "border-right-style: dotted;"
                End If
                'ボーダーの出力(下)
                If border_bottom.LineStyle = 1 Then
                    Select Case border_bottom.Weight
                        Case 1
                            buf = buf & "border-bottom-width:0.25px;"
                        Case 2
                            buf = buf & "border-bottom-width:0.5px;"
                        Case -4138
                            buf = buf & "border-bottom-width:1.0px;"
                        Case 4
                            buf = buf & "border-bottom-width:2px;"
                    End Select
                Else
                    buf = buf & "border-bottom-style: dotted;"
                End If
                'スタイルタグを閉める
                buf = buf & doubleQuate & " > "
                
                If InStr(Cells(Row, Column), "$") = 1 Then
                    buf = buf & "<input class='defaultInput' type='text' name='" & Mid(Cells(Row, Column), 2, Len(Cells(Row, Column)) - 1) & "' ></input></div>" & vbCrLf
                Else
                    buf = buf & Cells(Row, Column) & "</div>" & vbCrLf
                End If
                
            End If

         End With
    Next Column
Next Row
'submitボタンをどこに配置するか、変更が必要。
buf = vbCrLf & buf & "</div><input type=""submit"" value=""送信する"">" & vbCrLf

'ヘッダー
Dim htmlHeader As String
htmlHeader = "<!doctype html>" & vbCrLf & "<html lang=""ja"">" & vbCrLf & "<head>" & vbCrLf & "<meta charset=""Shift_JIS"">" & vbCrLf & "<title>Your Title</title>" & vbCrLf & "<meta name=""description"" content=""excell2html"">" & vbCrLf & "<link rel=""stylesheet"" href=""./style.css"">" & vbCrLf & "</head>" & vbCrLf
'ヘッダーをつけ、bodyタグとformタグで挟む
buf = htmlHeader & "<body>" & vbCrLf & "<form action="""" method='POST'>" & vbCrLf & buf & "</form>" & vbCrLf & "</body></html>"

'結果の出力 (Shift-JISで出力される)。
Dim strFilePath As String
strFilePath = ActiveWorkbook.Path & ":" & ActiveSheet.Name & ".html"
Open strFilePath For Output As #2
Print #2, buf
Close #2

End Sub

[後日記]久々に動かしたところ最初はうまく動きませんでした(Mac)。以下の変更し、さらにファイルパスを全てアルファベットになる様にしたところ動作しました。OS周りの変更があったのかもしれませんが、詳細は不明です。

strFilePath = ActiveWorkbook.Path & ":" & ActiveSheet.Name & ".html"
を
strFilePath = ActiveWorkbook.Path & "/" & ActiveSheet.Name & ".html"
に変更

出力結果ファイルをブラウザなどで表示するには以下のCSSファイルが必要です。

style.css

/* ボーダーとmargin?を含めた大きさにするのに必要 */
*, *:before, *:after {
    -webkit-box-sizing: border-box;
       -moz-box-sizing: border-box;
         -o-box-sizing: border-box;
        -ms-box-sizing: border-box;
            box-sizing: border-box;
}

.clearfix::after {
    content : " ";
    display : block;
    clear : both;
}

.flexbox{
    border:solid 0.1px rgb(100, 100, 100);
    padding: 0px;
    display: flex;
    align-items: center;/* 縦方向中央揃え */
    /*justify-content: center; 横方向中央揃え */
    position:absolute;
}

.inputCell{
    border:solid 0.1px rgb(100, 100, 100);
    position:absolute;
}

.defaultInput{
    height:100%;
    width:100%;
    padding:5px;
    background-color:rgb(236, 255, 234);
    border: 0px;
}

input:focus {
    outline: 2.1px solid rgb(68, 96, 255); /* 線幅、線のスタイル、カラー */
    outline-offset: -1px; /* 対象の要素からの距離、マイナス(内側)にも対応 */    
}

#実行例

神エクセルの例(変換前)

変換後(薄緑色の箇所が、入力箇所)

#問題点

1つのセルに複数のフォントおよびフォントサイズを使用できない
出力が冗長
送信ボタンの位置修正が必要
出力がShift-JIS(UTF8が望ましい)

などなどはまあ良いとして、入力データの受付処理は、別途記述しなくてはなりません。受け取ったデータを適切にチェックして、必要ならばエラーを返して表示する機能が必要でしょう。また、受け取ったデータを、ファイルに書き出すなり、データベースへ書き出すなりしなくてはなりません。

受け取ったデータの処理については、一般化が難しいのでここでは記述しません。ここにあるコードを使って「プログラミングはできないが神エクセルは作れる」人から神エクセルファイルをもらって、htmlフォームを作ることが簡単になったのではないかと思います。

#終わりに
本コードが、在宅ワークをちょっとでも後押しすることになれば幸いです。このコードを見て、改良できる！と思うプログラマーの方はたくさんいらっしゃるでしょう。どんどん改良してください。コメントも歓迎いたします。