エクセルの表をそのままはれるWeb上の掲示板、CMSがありますが、情報が多くなりすぎます。そこで、エクセルを単なるHTML上のテーブルに変換したいのですが、簡単にできるローカルのツールはあるでしょうか?

たとえば
Web上と同じようにテキストエリアがあり、それにエクセルの表を貼り付けると、そっけないテーブルに変換してくれるものです。
エクセルのマクロでもいいです。選択部分をテーブルに変換するだけなので、いくらでも存在すると思われます。使いやすいものを教えてください。

回答の条件
  • URL必須
  • 1人2回まで
  • 13歳以上
  • 登録:2010/06/24 15:13:53
  • 終了:2010/06/25 19:54:16

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692010/06/25 15:59:30

ポイント300pt

こんな感じかな

Sub HTMLの表組を作るマクロ2()
    Dim str As String
    Dim r As Range
    Dim i As Long
    Dim j As Long
    Dim CB As New DataObject
    Dim f As Boolean
    Dim cCount As Integer
    Dim rCount As Integer
    Dim cSpan As String
    Dim rSpan As String
    Dim linkSt As String
    Dim linkEd As String
    
    Set r = Selection
    
    str = "<table border>"
    For i = r.Row To r.Row + r.Rows.count - 1
        str = str & "<tr>"
        For j = r.Column To r.Column + r.Columns.count - 1
            f = True
            rSpan = ""
            cSpan = ""
            rCount = 0
            cCount = 0
            linkSt = ""
            linkEd = ""
            If i > 1 Then
                If Not Intersect(Cells(i, j), Cells(i - 1, j).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If j > 1 Then
                If Not Intersect(Cells(i, j), Cells(i, j - 1).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If f Then
                While Not Intersect(Cells(i, j + cCount), Cells(i, j).MergeArea) Is Nothing
                    cCount = cCount + 1
                Wend
                If cCount > 1 Then
                    cSpan = " colspan=" & cCount
                End If
                While Not Intersect(Cells(i + rCount, j), Cells(i, j).MergeArea) Is Nothing
                    rCount = rCount + 1
                Wend
                If rCount > 1 Then
                    rSpan = " rowspan=" & rCount
                End If
                                
                If Cells(i, j).Hyperlinks.count > 0 Then
                    linkSt = "<a href=" & Cells(i, j).Hyperlinks(1).Address & ">"
                    linkEd = "</a>"
                End If
                
                str = str & "<td" & rSpan & cSpan & ">" & linkSt & Cells(i, j).Value & linkEd & "</td>"
            
            
            End If
        Next j
        str = str & "</tr>"
    Next i
    str = str & "</table>"
    
    CB.SetText str
    CB.PutInClipboard
End Sub

http://q.hatena.ne.jp/

id:kaiketsu

ばっちりです。

2010/06/25 19:53:46

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/06/24 16:56:06

ポイント27pt

たぶん検索すれば無数にあると思いますが、そこは私、VBAで簡単な物を作ってみました。

機能を増やして、セルや文字の色とかも反映させてもいいのですが、今回は表組だけに絞ってシンプルにしました。

Excelのマージセルに合わせて表組が作成されるようなっています。


表を選択して実行すると、作成されたHTMLがコピーされますので、テキストエリアにペーストしてください。

注)Microsoft Forms 2.0 Object Libraryを参照設定してください。

ユーザーフォームを追加して削除すると勝手に追加されます。


Sub HTMLの表組を作るマクロ()
    Dim str As String
    Dim r As Range
    Dim i As Long
    Dim j As Long
    Dim CB As New DataObject
    Dim f As Boolean
    Dim cCount As Integer
    Dim rCount As Integer
    Dim cSpan As String
    Dim rSpan As String
    
    Set r = Selection
    
    str = "<table border>"
    For i = r.Row To r.Row + r.Rows.count - 1
        str = str & "<tr>"
        For j = r.Column To r.Column + r.Columns.count - 1
            f = True
            rSpan = ""
            cSpan = ""
            rCount = 0
            cCount = 0
            If i > 1 Then
                If Not Intersect(Cells(i, j), Cells(i - 1, j).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If j > 1 Then
                If Not Intersect(Cells(i, j), Cells(i, j - 1).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If f Then
                While Not Intersect(Cells(i, j + cCount), Cells(i, j).MergeArea) Is Nothing
                    cCount = cCount + 1
                Wend
                If cCount > 1 Then
                    cSpan = " colspan=" & cCount
                End If
                While Not Intersect(Cells(i + rCount, j), Cells(i, j).MergeArea) Is Nothing
                    rCount = rCount + 1
                Wend
                If rCount > 1 Then
                    rSpan = " rowspan=" & rCount
                End If
                str = str & "<td" & rSpan & cSpan & ">" & Cells(i, j).Value & "</td>"
            End If
        Next j
        str = str & "</tr>"
    Next i
    str = str & "</table>"
    
    CB.SetText str
    CB.PutInClipboard
End Sub

http://q.hatena.ne.jp/answer

id:kaiketsu

おお、すばらしい。リンクも一緒にHTML化するのは簡単でしょうか?

2010/06/25 15:15:48
id:yamaneroom No.2

yamaneroom回答回数1040ベストアンサー獲得回数612010/06/24 18:17:53

ポイント15pt

ConvHTML

ExcelのワークシートをワンクリックでHTMLテーブルソースに変換 文字色や背景色にも対応

http://www.vector.co.jp/soft/winnt/net/se455296.html

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692010/06/25 15:59:30ここでベストアンサー

ポイント300pt

こんな感じかな

Sub HTMLの表組を作るマクロ2()
    Dim str As String
    Dim r As Range
    Dim i As Long
    Dim j As Long
    Dim CB As New DataObject
    Dim f As Boolean
    Dim cCount As Integer
    Dim rCount As Integer
    Dim cSpan As String
    Dim rSpan As String
    Dim linkSt As String
    Dim linkEd As String
    
    Set r = Selection
    
    str = "<table border>"
    For i = r.Row To r.Row + r.Rows.count - 1
        str = str & "<tr>"
        For j = r.Column To r.Column + r.Columns.count - 1
            f = True
            rSpan = ""
            cSpan = ""
            rCount = 0
            cCount = 0
            linkSt = ""
            linkEd = ""
            If i > 1 Then
                If Not Intersect(Cells(i, j), Cells(i - 1, j).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If j > 1 Then
                If Not Intersect(Cells(i, j), Cells(i, j - 1).MergeArea) Is Nothing Then
                    f = False
                End If
            End If
            If f Then
                While Not Intersect(Cells(i, j + cCount), Cells(i, j).MergeArea) Is Nothing
                    cCount = cCount + 1
                Wend
                If cCount > 1 Then
                    cSpan = " colspan=" & cCount
                End If
                While Not Intersect(Cells(i + rCount, j), Cells(i, j).MergeArea) Is Nothing
                    rCount = rCount + 1
                Wend
                If rCount > 1 Then
                    rSpan = " rowspan=" & rCount
                End If
                                
                If Cells(i, j).Hyperlinks.count > 0 Then
                    linkSt = "<a href=" & Cells(i, j).Hyperlinks(1).Address & ">"
                    linkEd = "</a>"
                End If
                
                str = str & "<td" & rSpan & cSpan & ">" & linkSt & Cells(i, j).Value & linkEd & "</td>"
            
            
            End If
        Next j
        str = str & "</tr>"
    Next i
    str = str & "</table>"
    
    CB.SetText str
    CB.PutInClipboard
End Sub

http://q.hatena.ne.jp/

id:kaiketsu

ばっちりです。

2010/06/25 19:53:46
  • id:kaiketsu
    簡単にリンク先が取得できるみたい。


    Range("C2").Hyperlinks(1).Address

    http://hpcgi1.nifty.com/kenzo30/b_cbbs/cbbs.cgi?mode=al2&namber=4919&rev=&no=0&P=R&KLOG=34
  • id:SALINGER
    実は、表組み、リンク、文字色、背景色、アラインメントまでは反映するものを作ったけど、
    セルの高さと幅を実装しようとして中断してたりします。
    そのうち個人的にはてなの回答で表組みを使う為に、回答欄で使えるタグだけに絞ったものを作ろうかとも思ってたりします。
  • id:kaiketsu
    セルの幅の実装もそれほど難しくはなさそうですね。
  • id:SALINGER
    セル幅、高さ対応版は下記のトラックバックのブログにあげておきます。

この質問への反応(ブックマークコメント)

トラックバック

  • HTMLの表組を作るマクロ http://q.hatena.ne.jp/1277360031 こちらの質問ではExcelの表組をそのままHTMLの表組にするマクロを回答しました。 その発展形として機能を追加したものです。 枠組み 背景色
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません