Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5613 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【49974】webページとして保存でタイトルをつけるには きたろう 07/7/1(日) 16:25 質問[未読]
【49987】Re:webページとして保存でタイトルをつける... きたろう 07/7/2(月) 6:45 回答[未読]
【49974】webページとして保存でタイトルをつける...
質問  きたろう  - 07/7/1(日) 16:25 -
引用なし
パスワード
   県の職員です。
万策尽きました。

最後の
k = "%fg%c%t" + b + "{~}" + "%n" + f + "{~}"
でうまく動きません。

やりたいことはエクセルのシートにある公告文を毎週多数htmlにして
県のホームページに入札公告としてアップロードするのですが、
数が多いため現在のコンポーザーで変換する方法を改めエクセルの
vbaで自動作成するように考えました。
　

webページとして保存でタイトルをつける方法は
マイクロソフトの以下のページで解説されていますが、県庁ではvbはインスト
してくれそうにありません。
エイチテーテーp://msdn2.microsoft.com/ja-jp/library/microsoft.office.tools.excel.workbook.title(VS.80).aspx

なんとかエクセルオンリーでできないでしょうか。

Sub Macro1()

Dim b As Variant, f As Variant
Dim k As Variant

f = Sheets("入力").Range("$b$5").Value
b = Sheets("入力").Range("$b$3").Value + "にかかる入札"

　　Sheets("HTML書出").Select
　　Range("a8:b155").Select
　　Selection.ClearContents
　　
　　Sheets("公告書").Select
　　Range("A2:A146").Select
　　Selection.Copy
　　
　　Sheets("HTML書出").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　　　　:=False, Transpose:=False
　
　　Cells.Select
　　Selection.Copy
　　Workbooks.Add
　　ActiveSheet.Paste
　　Range("A162").Select
　　Application.CutCopyMode = False
　　Selection.Hyperlinks(1).SubAddress = "Sheet1!A1"
　　
　　k = "%fg%c%t" + b + "{~}" + "%n" + f + "{~}"
　　
　　Application.SendKeys k
'できればつくるhtmlファイルを上書きできるようにしていただければ
'有難いです。

End Sub
【49987】Re:webページとして保存でタイトルをつけ...
回答  きたろう  - 07/7/2(月) 6:45 -
引用なし
パスワード
   きたろうです。自問自答です。

下のように書いてうまく動きました。疲れました。
なお、キルコマンドはファイル削除コマンドで閲覧者の方に
危険ですのでキルと書いておきました。

最初mht（mhtml）ファイルで書き出した後、再度htmlで
書き出しているのは、ほしいのはhtmlだけなのですが、
いきなりhtmlで書き出すと、エクセルのＡ列の各行で
左端や右端が不ぞろいになるため、mhtで書き出したあ
と再度htmlで書き出しています。
そして最後にmhtファイルをキルコマンドで削除しました。

Sub Macro1()

Dim fg As Variant, fh As Variant, t As Variant


fg = Sheets("入力").Range("$b$5").Value
fh = Sheets("入力").Range("$b$5").Value

t = fg + ".*"

If Dir("") = t Then
キル pathname:=t
End If


t = Sheets("入力").Range("$b$3").Value + "にかかる入札"

　　Sheets("HTML書出").Select
　　Range("a8:b155").Select
　　Selection.ClearContents
　
　
　　Sheets("公告書").Select
　　Range("A2:A146").Select
　　Selection.Copy
　　Sheets("HTML書出").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 　　　　　SkipBlanks _
　　　　:=False, Transpose:=False
　
　
　　Cells.Select
　　Selection.Copy
　　Workbooks.Add.Title = t
　　ActiveSheet.Paste
　　Range("A162").Select
　　Application.CutCopyMode = False
　　Selection.Hyperlinks(1).SubAddress = "Sheet1!A1"

fg = fg + ".mht"
ActiveWorkbook.SaveAs Filename:= _
　　 fg, FileFormat:= _
　　　　xlWebArchive, CreateBackup:=False
　
　fh = fh + ".html"
　ActiveWorkbook.Title = t
　　ActiveWorkbook.SaveAs Filename:= _
　　　　fh, FileFormat:=xlHtml, _
　　　　ReadOnlyRecommended:=False, CreateBackup:=False

キル pathname:="*.mht"

End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5613 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free