[[20130323221730]]　『エクセル2010のフォント』（フォント）　ページの最後に飛ぶ

『エクセル2010のフォント』（フォント）

 エクセル・ワードとかで使用できるフォント名をファイルに書き出したいのですが
 可能でしょうか。数えてみますと１８４種類位あり
 よろしくお願い致します。

↓にあるのは、参考になりますか（マナ）

 　
http://officetanaka.net/excel/vba/tips/tips41.htm
 　
 Sub test()
    Dim i As Long

    With Application.CommandBars("Formatting").Controls(1)
        For i = 1 To .ListCount
            Cells(i, 1).Value = .List(i)
        Next i
    End With

 End Sub

 凄い。驚きでした。
 初心者なもので最初は何が何だか分かりませんでしたが
 何とか分かりましたマクロと言うものですね
 もう一つ質問があります。
 A１にフォントの書き出し　C1には　123 あいう　ABC abc　壱弐参　と例を入力し
 B1から（B:B）にA列に書き出したフォントにして書き出す。
 さすがにこれは無理と思い初心者なりに恥を忍んでお聞きしますので
 よろしくお願い致します。

 ご参考までに。

 他にもやりたいことが出てくると思いますが、ネットで検索したりマクロの記録を利用
 すると、自分でもいろいろできるようになるかと思います。
 (Mook)

 Option Explicit
 Sub FontSample()
    Application.ScreenUpdating = False
    Dim r As Long
    With Application.CommandBars("Formatting").Controls(1)
        Range("B1").Resize(.ListCount, 5) = Array("123", "あいう", "ABC", "abc", "壱弐参")
        For r = 1 To .ListCount
            Cells(r, "A").Value = .List(r)
            Cells(r, "B").Resize(1, 5).Font.Name = .List(r)
        Next
    End With
    Columns("A:F").AutoFit
    Application.ScreenUpdating = True
 End Sub

↑のMookさんのをワードを利用するように変更して、たて書き対応のフォント(@)も表示させてみました（マナ）

 Sub test2()
    Dim r As Long

    Application.ScreenUpdating = False
    With CreateObject("Word.Application")
        Range("B1").Resize(.FontNames.Count, 5) = Array("123", "あいう", "ABC", "abc", "壱弐参")
        For r = 1 To .FontNames.Count
            Cells(r, "A").Value = .FontNames(r)
            Cells(r, "B").Resize(1, 5).Font.Name = .FontNames(r)
        Next
        .Quit
    End With
    Columns("A:F").AutoFit
    Application.ScreenUpdating = True
 End Sub

 ありがとうございました。
 (Mook)さん（マナ）さんのの早速入れて実行しましたが

 (Mook)さんのマクロは数秒で
 実行時エラー’1004’
 FontクラスのNameプロパティを設定できません
 が出てしまい”終了”を押しますとA1～A963までは変更され
 後は変更されない"123", "あいう", "ABC", "abc", "壱弐参"のままです。

 （マナ）さんのは数分後に同じメッセージが出ます。

 最初から私が説明不足と言葉足らずで申し訳ございません。
 実は現在Windows7エクセルバージョン2010を使用しています。
 フォント追加ソフト（某社の5700）を入れ込みまして現在
 2686あります。ですからA2686まで出ていますが今後もう少し追加を
 考えておりますのでそれに対応出来ればと思います。
 大変申し訳ございませんがよろしくお願い致します。（フォント）

すみません。よくわかりませんが、種類が多すぎるのですかね（マナ）

 こちらでは、そんなにフォントの種類がないので確認できませんが
 フォントカラーも変えたら、９０７種類目でエラーになりました。

 ありがとうございます。
 やはり限界があるのですね。
 変換出来ない部分は手作業で行うしかないですと思うと...
 でも１/3はマクロで表示出来ましたのでそれだけでも助かりました。
 (フォント)

少なければできるのであれば、★の行を変えて、分割操作するのはどうですか（マナ）

 ４つの新規ブックで800個ずつ処理の場合

 For r = 1 To 800
 For r = 801 To 1600
 For r = 1601 To 2400
 For r = 2401 To .ListCount

 Sub test3()
    Dim r As Long
    Dim n As Long

    Application.ScreenUpdating = False
    With Application.CommandBars("Formatting").Controls(1)
        Range("B1").Resize(800, 5) = Array("123", "あいう", "ABC", "abc", "壱弐参")
        For r = 1 To 800	'★
            n = n + 1
            Cells(n, "A").Value = .List(r)
            Cells(n, "B").Resize(1, 5).Font.Name = .List(r)
        Next
    End With
    Columns("A:F").AutoFit
    Application.ScreenUpdating = True
 End Sub

 ありがとうございました。
 しかし今度は800を超えますとエラーが出てしまい変換できません。
 For r = 1 To 800
 For r = 801 To 1600
 For r = 1601 To 2400
 For r = 2401 To .ListCountと変更したのですが。（フォント）

 手作業で行おうとしましたがB963　C963　D963　とここから下が
 新しいフォントはこれ以上使用できません。

 開いている他のドキュメントを閉じてから再度実行してください。
 とメッセージが出ることが判明しました。
 他の新しいファイルで行ったところ手作業で変更出来なかったフォントを
 選択し変更したらできました。
 なぜでしょうか疑問です（フォント）
 ----
 戻って申し訳ないのですが
 少なければできるのであれば、★の行を変えて、分割操作するのはどうですか
４つの新規ブックで800個ずつ処理の場合
 をもう少し詳しく教えて下さい。
 面倒だと思いますが４つ分の式を載せていただけませんでしょうか(フォント)

初めてマクロを使った方への説明としては、とても不親切な回答ですよね。ごめんなさい（マナ）

 1)エクセルを再起動
 2)新規ブックに、test3マクロをコピーし実行
 3)ブックを保存
 4)エクセルを再起動
 5)新規ブックに、test3マクロをコピー
 6)★の行を、修正し実行（For r = 801 To 1600）
 7)ブックを保存
 8)エクセルを再起動

 といった感じです。

申し訳ありませんが、たぶん、明後日まで、これで回答できないと思います（マナ）

 なので、駄目元でワードのマクロを載せておきます。
 ↑がうまくいかない場合に、試してみてください。
 エクセルと同じように、標準モジュールにコピーして使います。

 Sub test4()
    Dim r As Long
    Dim i As Long

    Application.ScreenUpdating = False

    With ActiveDocument
        .Content.Font.Size = 8
        With .Content.ParagraphFormat
            .LineSpacingRule = wdLineSpaceExactly
            .LineSpacing = 8
        End With

        r = FontNames.Count

        .Tables.Add Range:=.Range, NumRows:=r, NumColumns:=6
        For i = 1 To r
            .Tables(1).Cell(i, 1).Range.Text = FontNames(i)
            .Tables(1).Cell(i, 2).Range.Text = "123"
            .Tables(1).Cell(i, 3).Range.Text = "あいう"
            .Tables(1).Cell(i, 4).Range.Text = "ABC"
            .Tables(1).Cell(i, 5).Range.Text = "abc"
            .Tables(1).Cell(i, 6).Range.Text = "壱弐参"
            .Range(.Tables(1).Cell(i, 2).Range.Start, .Tables(1).Cell(i, 6).Range.End).Font.Name = FontNames(i)
        Next
        .Tables(1).Columns.AutoFit
    End With

    Application.ScreenUpdating = True

End Sub

 たしかEXCELでは同時に使用できる書式に制限があったと思いますが、それに引っかかっているのではないでしょうか。
 2007以降では4000から64000へ拡張されていますけれど、今回使用しているファイルは xlsm の拡張しにして保存した
 もので実行しているでしょうか。
 (Mook)

 (Mook)さん（マナ）さんのご指導ありがとうございました。
 結果ですが
 1)エクセルを再起動
 2)新規ブックに、test3マクロをコピーし実行
 3)ブックを保存 
 4)エクセルを再起動
 5)新規ブックに、test3マクロをコピー
 6)★の行を、修正し実行（For r = 801 To 1600）
 7)ブックを保存
 8)エクセルを再起動
 で行い2685個のフォントで書き出し印刷を行いました。
 また、xlsm の拡張しにして保存したもので実行しているでしょうか。
 はい。しています。しかし駄目でした。

 For r = 1 To 800
 For r = 801 To 1600
 For r = 1601 To 2400
 For r = 2401 To .ListCountで出したフォントデーターを一つに貼り付けしようと
 したのですが”新しいフォントはこれ以上使用できません”と出てしまい
 貼り付け不可でした。

 しかしフォント数が多すぎで動きが少々重いような感じがしますので
 一旦アインストールを行い綺麗なフォントのみを入れたいと思います。
 ありがとうございました。（フォント）
 ----
 最後にエクセル2010のフォントはどの位あるのでしょうか
 ネットで調べましたが一覧がないようですが何故なのでしょうか（フォント）

 c:\windows\fonts

 以下のフォルダ下を調べてみると、見つかるかもしれませんよ！！
 もっとも、更にフォルダがあるので、そこまで調べなければなりませんが・・・。

 Sub test()
    Dim win, objfolder, obj
    Dim str(8) As String
    Dim i As Long
    Dim j As Long
    Set win = CreateObject("Shell.Application")
    Set objfolder = win.Namespace("c:\windows\fonts")
    For i = 0 To 8
       str(i) = objfolder.GetDetailsOf(, i)
    Next
    Range("a1:i1").Value = str
    i = 2
    For Each obj In objfolder.Items
       For j = 0 To 8
          Cells(i, j + 1).Value = objfolder.GetDetailsOf(obj, j)
       Next
    i = i + 1
    Next
    MsgBox "done"
    Set win = Nothing
    Set objfolder = Nothing
    Set obj = Nothing
 End Sub

 新規ブックの標準モジュールに上記コードでためしてみてください。

 おおよそのデータは得られると思います。

 本当にやるなら、APIですねえ・・・、検索したらありましたよ

http://homepage1.nifty.com/MADIA/vb/API/EnumFonts.htm

 もっともこれ、デバイスコンテキストのハンドルの取得と解放のAPIも必要なので
 それは、調べなければなりませんが・・・（GetDC, ReleaseDC辺り）。

 ichinose

コメント返信：

[ 一覧(最新更新順) ]

[[20130323221730]] 『エクセル2010のフォント』（フォント） ページの最後に飛ぶ

[[20130323221730]]　『エクセル2010のフォント』（フォント）　ページの最後に飛ぶ