エクセルファイルをHTML化する際のマクロの設定

質問

会社のみんなが、手軽に更新履歴を書き込めるように、マクロにてエクセル内のあるシートをHTML化しています。
上記で自動生成したファイルは実はあるHTMLファイルのフレームの部品となっています。（Top、Left、RightのうちのRightです）

しかし上記のファイルはなぜか、必ずフレームの中でセンタリングされてしまうため、ブラウザのウインドを大きくすると、レイアウトが狂ってしまい困ってます。（top、leftは左寄せになっています）

何とかマクロの範疇で左寄せにできないでしょうか？

以下マクロのHTML化の部分です。
--------------------------------------------------
'HTML化始め
With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
"HTMLのパス", "シート名", "" _
, xlHtmlStatic, "test0001_29648", "")
.Publish (True)
.AutoRepublish = False
End With
'HTML化終了
--------------------------------------------------

ちなみに・・・
出来上がったHTMLファイルには
<div id="test0001_29648" align=center x:publishsource="Excel">

という記述があり、ここを無理やりleftと変えると左詰になりました。

よろしくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんにちは。Wendy02です。

#2372623 と合わせて、こちらに書いておきます。

細かい、部分を手直ししました。

'//*標準モジュール*//
'Option Explicit

Sub OutHtml()
'Excel 2002 用（Excel 2003 可)
'注意：MYTITLE は、拡張子を入れないでください。
Const MYTITLE As String = "test0001_29648"

Dim myPath As String
Dim myFName As String
Dim ShName As String
Const EXT As String = ".mht" '拡張子指定

'フォルダを指定してください。
myPath = ThisWorkbook.Path & "\"

ShName = ActiveSheet.Name
myFName = myPath & MYTITLE & EXT
With ActiveWorkbook.PublishObjects.Add( _
　　　　　　　SourceType:=xlSourceSheet, _
　　　　　　　Filename:=myFName, _
　　　　　　　Sheet:=ShName, _
　　　　　　　HtmlType:=xlHtmlStatic, _
　　　　　　　Title:=MYTITLE)
　 .Publish True
　 .AutoRepublish = False
End With
ReplaceTextMacro myFName
End Sub

Sub ReplaceTextMacro(inFname As String)
'ファイル内部書き換え用マクロ
Dim inFno As Integer, outFno As Integer
Dim outText As String
Dim Re As Object
Dim TextLine As String
Dim Matches As Object, Match As Object
Dim buf As String
Dim OUTFNAME As String

Const REPSTRING As String = "Left"

OUTFNAME = Mid(inFname, 1, InStrRev(inFname, ".") - 1) & ".bak"

Set Re = CreateObject("VBScript.RegExp")
Re.Pattern = "align=([^\s]+)"
Re.Global = False
inFno = FreeFile()
Open inFname For Input As #inFno
outFno = FreeFile()
Open OUTFNAME For Output As #outFno
Do While Not EOF(inFno)
　　Line Input #inFno, TextLine
　　If Re.test(TextLine) Then
　　 Set Matches = Re.Execute(TextLine)
　　 Set Match = Matches(0)
　　 buf = Trim$(Match.SubMatches(0))
　　 outText = Replace(TextLine, buf, REPSTRING)
　　 Print #outFno, outText
　　 buf = ""
　　Else
　　　Print #outFno, TextLine
　　End If
Loop
　Close #inFno
　Close #outFno

　Name inFname As "tmp.mht"
　Name OUTFNAME As inFname
　Kill "tmp.mht"　'Tmpファイル削除

　Set Re = Nothing

End Sub

お礼

色々ありがとうございました
完璧です！！
大変助かりました

回答No.3

Wendy02

こんばんは。

あッ、大変、すみません。一目で、コードが間違っているのが分かりました。ここで書いている時点では、コードは実際に動かしてはいませんが、間違いはないと思います。私は、寝ぼけていたのかもしれませんね。

下から14行上、Else から、３行目　（ライン除く)

Write #outFno, outText

　↓
Print #outFno, outText

です。

それと、

一番上から、9行目（ライン除く)
Const REPSTRING As String ="Left"　'新しい置換値

なお、そちらExcel 2002 ですから、 align=Left のほうがよいでしょうね。8/30付けのご質問で再確認しました。

回答No.2

Wendy02

こんばんは。

>取り込んでReplaceとなると、面倒そうですね。

そんなことはないです。以下を見ていただければよいのですが、マクロのできる方でしたら、何だこんなものっていう感じだと思います。ただ、ちょっと気になることがあって、正規表現検索に切り替えました。私の方では、3DCenter とか、3DLeft になっていますので、その用意のためです。

もっと簡単にするなら、ScriptingObjectのテキストストリームで、（テキスト)ファイルを一気に読み込んで、それをReplace して、吐き出せばよいです。例えば、今、ごらんになっている、ここのページ全部を一括で読むことも可能です。それと、必ず、「align=center」というようになっているなら、それでよいはずです。昔は、理論的には可能でも、出来ませんでしたが、今は可能になりました。

VBAの変数のテキストバッファの大きさは忘れましたが、数万行だったと思います。汎用性を考えたのでやめました。

なお、ファイル名(INFNAME)はキメウチですから、定数の行を削除して、それを、プロシージャの引数にして、元のコードのサブルーチンにすれば出来上がります。

'-----------------------------------------------------------
Sub ReplaceTextMacro()

Dim inFno As Integer, outFno As Integer
Dim outText As String
Dim Re As Object
Dim TextLine As String
Dim Matches As Object, Match As Object
Dim OutFname As String
Const INFNAME As String = "test0001.mht"　'ファイル名
Const REPSTRING As String = "3DLeft"　'新しい置換値

OutFname = Mid(INFNAME, 1, InStrRev(INFNAME, ".") - 1) & ".bak"

Set Re = CreateObject("VBScript.RegExp")
Re.Pattern = "align=([^\s]+)"
Re.Global = False
inFno = FreeFile()
Open INFNAME For Input As #inFno
outFno = FreeFile()
Open OutFname For Output As #outFno
Do While Not EOF(inFno)
　　Line Input #inFno, TextLine
　　If Re.Test(TextLine) Then
　　 Set Matches = Re.Execute(TextLine)
　　 Set Match = Matches(0)
　　 Buf = Trim$(Match.SubMatches(0))
　　 outText = Replace(TextLine, Buf, REPSTRING)
　　 Write #outFno, outText
　　 Buf = ""
　　Else
　　　Print #outFno, TextLine
　　End If
Loop
　Close #inFno
　Close #outFno
　'ファイル名の交換
　Name INFNAME As "tmp.mht"
　Name OutFname As INFNAME
　Name "tmp.mht" As OutFname

　Set Re = Nothing

End Sub
'-----------------------------------------------------------

お礼

ありがとうございます！！
ここまで面倒見ていただいて感謝感謝です！！
大変助かりました。
早速使ってみます。

補足

すみません！！
やってみたところ
<div id="test0001_29648" align=center x:publishsource="Excel">
⇒
"<div id=""test0001_29648"" align=3DLeft x:publishsource=""Excel"">"
となってしまい、””（ダブルクォーテーションマーク）が画面に現れてしまいます。

ナゼでしょうか？

ちなみに、上記のsubをFunction化してファイル名を引数渡しにしているます。
※スミマセンマクロは初心者なモノで・・・

回答No.1

Wendy02

こんばんは。

どうもデフォルトでなっているようで、設定を探してみましたが、見つかりません。
それなので、一旦吐き出した後に、そのファイルを取り込んで、Replace で、align=center　をalign=left に、書き換えてしまったらどうですか？
今調べてみましたが、align=***　は、そのファイル(シート)で一意のようですから、問題ないと思います。

お礼

そうですか・・・・
取り込んでReplaceとなると、面倒そうですね。
とにかく動かすことが先決ですから、エクセルで横幅をすごく長くして、無理やり左寄せにすることで、一時しのぎにします。（フレームの幅に入りきらない部品HTMLは左寄せになるらしい）

その後でじっくりご提案のやり方を作りこんでいきます。
（もちろん、平行して他の方法の検索も探してみます）
ありがとうございました。