| |
Jaka さん、カド さん、こんばんは。
>これを実現する方法より、プロパティがないのなら、ない理由が何故なのか気になります
ちょっと、深読みしすぎました？
Htmlprojectは、Helpでも公開されていますからねえ・・・。
コードと一緒に面白い現象も合わせて
標準モジュールに
'=====================================================================
Sub main()
Dim bknm As Variant
Dim svbknm As String
bknm = Application.GetOpenFilename("Excel ファイル (*.xls), *.xls")
If TypeName(bknm) <> "Boolean" Then
With Workbooks.Open(bknm)
svbknm = .Name
End With
Call set_save_preview(Workbooks(svbknm))
With Workbooks(svbknm)
.Save
.Close
End With
MsgBox "プレビュー設定完了"
End If
End Sub
'=====================================================================
Sub set_save_preview(bk As Workbook)
Dim idx As Long, jdx As Long
Dim otext As Variant
Dim hhh As HTMLProjectItem
Dim ntext() As String
With bk
otext = Split(.HTMLProject.HTMLProjectItems(1).Text, vbCrLf)
jdx = 1
For idx = LBound(otext) To UBound(otext)
ReDim Preserve ntext(1 To jdx)
ntext(jdx) = otext(idx)
If otext(idx) = "<head>" Then
ReDim Preserve ntext(1 To jdx + 1)
ntext(jdx + 1) = "<link rel=Preview>"
jdx = jdx + 1
End If
jdx = jdx + 1
Next
.HTMLProject.HTMLProjectItems(1).Text = Join(ntext(), vbCrLf)
.HTMLProject.RefreshProject True
.HTMLProject.RefreshDocument True
End With
End Sub
mainを実行してみてください。
ファイル選択ダイアログから選択したブックの
「"プレビューの図を保存する"にチェックを入れる」
処理をした後、保存し、対象ブックを閉じます。
私がテストした限りでは、正常にチェックが入っています。
で面白い現象というのは・・・、
上記のMainプロシジャーを
'=====================================
Sub main2()
Dim bknm As Variant
Dim svbknm As String
bknm = Application.GetOpenFilename("Excel ファイル (*.xls), *.xls")
If TypeName(bknm) <> "Boolean" Then
With Workbooks.Open(bknm)
svbknm = .Name
Call set_save_preview(Workbooks(svbknm))
.Save
.Close
End With
MsgBox "プレビュー設定完了"
End If
End Sub
と前述のコードより、簡素化した記述をすると、
.Save
の箇所で
「オートメーションエラーです」というトラップが発生します。
どうやらブックオブジェクトのアドレスが変わっているようなのです。
set_save_previewプロシジャーの
.HTMLProject.RefreshProject True
.HTMLProject.RefreshDocument True
のコードを実行すると、その現象が見られます。
よって、set_save_previewプロシジャーを
呼び出した後で
再度、アドレッシングを行わなければなりませんでした。
尚、Excel2000、Excel2002で動作を確認しました。
試してみてください。
|
|
ichinose
- 05/10/24(月) 21:32 -
