現在、自分のPower Pointで利用できるすべてのフォントを、

VBAのコードで取得する方法を教えてください。

たとえばfontname(1000)という配列に、
fontname(1)="HGS教科書体"
fontname(2)="MS Pゴシック"
fontname(3)="怨霊" '←WindowsやOfficeに標準では入っていない

というように、後から自分で入れたフォントも
代入できるようにしたいのです。

「Microsoft Officeでインストールされるフォント一覧」だけなら
以下でわかるようなのですが・・・。
http://tacomakix.blog15.fc2.com/blog-entry-2.html

よろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 登録:
  • 終了:2006/12/04 02:04:27
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:zifree No.1

回答回数175ベストアンサー獲得回数6

ポイント35pt

CommandBarComboBoxのリストを見る方法があります。

イミディエイトウインドウにフォントの一覧を表示します。

PowerPoint2003でのみ確認。

Sub displayFont()

Dim ctrlBox As CommandBarComboBox

Dim i As Integer

With Application.CommandBars("Formatting")

If Left(Application.Version, 1) = 9 Then

Set ctrlBox = .Controls("フォント(&F):") 'PowerPoint2000,2003

Else

Set ctrlBox = .Controls("フォント(&F):") 'PowerPoint97?

End If

End With

For i = 1 To ctrlBox.ListCount

Debug.Print ctrlBox.List(i)

Next

End Sub

なお、

http://www.geocities.jp/vbaxl/sample/011.html

を参考にしました。

こちらはExcelでの方法になりますがPowerPointでもほぼ同じです。

id:lionfan

ありがとうございました!!

動きました!! やったーーーー!!!

本当にありがとうございます!!

2006/12/04 02:03:38

その他の回答1件)

id:zifree No.1

回答回数175ベストアンサー獲得回数6ここでベストアンサー

ポイント35pt

CommandBarComboBoxのリストを見る方法があります。

イミディエイトウインドウにフォントの一覧を表示します。

PowerPoint2003でのみ確認。

Sub displayFont()

Dim ctrlBox As CommandBarComboBox

Dim i As Integer

With Application.CommandBars("Formatting")

If Left(Application.Version, 1) = 9 Then

Set ctrlBox = .Controls("フォント(&F):") 'PowerPoint2000,2003

Else

Set ctrlBox = .Controls("フォント(&F):") 'PowerPoint97?

End If

End With

For i = 1 To ctrlBox.ListCount

Debug.Print ctrlBox.List(i)

Next

End Sub

なお、

http://www.geocities.jp/vbaxl/sample/011.html

を参考にしました。

こちらはExcelでの方法になりますがPowerPointでもほぼ同じです。

id:lionfan

ありがとうございました!!

動きました!! やったーーーー!!!

本当にありがとうございます!!

2006/12/04 02:03:38
id:zifree No.2

回答回数175ベストアンサー獲得回数6

ポイント265pt

回答オープン前に失礼しますが、一箇所間違えました。

私の環境(WinXP、PowerPoint2003)ではなぜか動いていますが、

PowerPoint2003のバージョンは11.0なので

Left(Application.Version, 1)

ではOfficeのバージョンを判別できていないですね・・・。

If Left(Application.Version, 1) = 9 Then

If CInt(Application.Version) > 9 Then

と変えて下さい。

ただしOffice12以降だとまた動かない可能性もありますし、

厳密にバージョンチェックを行いたい場合はApplication.Versionの結果で

Select Caseするような形が良いと思います。

id:lionfan

了解です。そのようにいたします。

本当にありがとうございました。

それではこれにて終了です!!

2006/12/04 02:04:03

コメントはまだありません

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

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

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

回答リクエストを送信したユーザーはいません