人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルの表をそのままはれるWeb上の掲示板、CMSがありますが、情報が多くなりすぎます。そこで、エクセルを単なるHTML上のテーブルに変換したいのですが、簡単にできるローカルのツールはあるでしょうか?
たとえば
Web上と同じようにテキストエリアがあり、それにエクセルの表を貼り付けると、そっけないテーブルに変換してくれるものです。
エクセルのマクロでもいいです。選択部分をテーブルに変換するだけなので、いくらでも存在すると思われます。使いやすいものを教えてください。


●質問者: kaiketsu
●カテゴリ:コンピュータ インターネット
✍キーワード:いもの エクセル エリア テキスト マクロ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● SALINGER
●27ポイント

たぶん検索すれば無数にあると思いますが、そこは私、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

◎質問者からの返答

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


2 ● yamaneroom
●15ポイント

ConvHTML

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

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


3 ● SALINGER
●300ポイント ベストアンサー

こんな感じかな

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/

◎質問者からの返答

ばっちりです。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ