【VBA×WindowsAPI】UserFormに回転させたテキスト(文字列)を描画する

VBAでUserFormを作成していると文字を回転させて表示させたいという場面に出くわすことがあります。しかしラベルをはじめコントロールは回転させることが出来ないので、VBAの標準機能だけではこれを実現することはできません。

しかし、WindowsAPIの関数を利用することでこの問題を解決することはできます。
そこで本ページではUserFormに任意の角度だけ回転したテキストを描画する方法を解説していきます。描画されるテキストはUserFormのコントロールのような実態のあるものではないため、少し取り扱いは難しいですがテキスト描画だけでいえばかなりの自由度のある設定が可能です。

UserFormに回転させたテキストを描画する

WindowsAPIを使うことで上画像のようにUserForm上に回転させたテキストを描画することができます。このとき描画するテキストは回転角度だけでなくフォントやサイズ、描画位置、フォント太さ、斜体、下線付き、取り消し線付きなどの細かな設定を行うことが可能です。

ただし、この方法で描画されるテキストはあくまでも視覚的に描画されているだけであり、ラベル等のコントロール(オブジェクト)として存在するわけではありません。テキストの値を変更するには既に描画されているテキストを消して再描画する必要があるので動的に扱う場合は注意が必要です。

WindowsAPIでテキストを描画するにはUserFormウィンドウが持つデバイスコンテキスト(DC)にアクセスする必要があります。DCとは主にウィンドウの描画関係の機能を取り扱うもので、GetDC関数GetWindowDC関数に引数として対象のウィンドウハンドルを渡すことで取得することができます。また、描画するテキストの値やサイズ、角度などの情報を持つ「論理フォント」というGDIオブジェクトを作成して、描画対象のDCに関連付けさせる必要があります

VBAでUserFormに回転させたテキストを描画するには下記のWindows APIを利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。

icon-check-square FindWindow関数              :ウィンドウハンドルを取得する
icon-check-square GetDC関数                        :デバイスコンテキスト(DC)を取得する
icon-check-square ReleaseDC関数                 :指定のDCを解放する
icon-check-square SelectObject関数              :指定のDCでオブジェクト(論理フォント)を1つ選択する
icon-check-square DeleteObject関数              :指定のオブジェクト(論理フォント)を1つ削除する
icon-check-square CreateFontIndirect関数  :論理フォントを作成する
icon-check-square TextOut関数                      :指定の論理フォントでテキストを描画する
icon-check-square SetBkMode関数                 :テキストの背景を透明にする

「そもそもWindows APIって何?」という方はコチラ(メインページ)も併せて参照下さい。
また、その他のウィンドウへの描画関連の操作に関しては下記も併せて参照下さい。

VBAで指定のウィンドウ(UserForm)に図形を描画する

サンプルコード

UserFormに回転させたテキストを描画するためのサンプルコードは下記の通りです。
下記コードをUserFormのコードにコピーペーストし、UseFormを表示させるだけで上画像の通り3つの回転したテキストを描画することができます。(※Topのみはラベルコントロールで作成したもの)

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDc As LongPtr) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPtr
Private Declare PtrSafe Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDc As LongPtr, ByVal nBkMode As Long) As Long

'論理フォント構造体
Private Const LF_FACESIZE = 32

Private Type LOGFONT
    lfHeight As Long                '文字の高さ
    lfWidth As Long                 '文字の平均幅
    lfEscapement As Long            '文字送りの方向とx軸との角度
    lfOrientation As Long           'ベースラインとx軸の角度
    lfWeight As Long                'フォント太さ (0~1000)
    lfItalic As Byte                '斜体指定
    lfUnderline As Byte             '下線付き指定
    lfStrikeOut As Byte             '取り消し線指定
    lfCharSet As Byte               '文字セット
    lfOutPrecision As Byte          '出力精度
    lfClipPrecision As Byte         'クリッピング精度
    lfQuality As Byte               '出力品質
    lfPitchAndFamily As Byte        'ピッチとファミリ
    lfFaceName(LF_FACESIZE) As Byte 'フォント名
End Type

'背景色透明化
Private Const TRANSPARENT = 1

Private hWnd        As LongPtr      'UserFormハンドル
Private hDc         As LongPtr      'UserFormデバイスコンテキスト

Private hFontDef    As LongPtr      'デフォルトフォント
Private cFonts      As Collection   '作成した論理ペンコレクション

'------------------------------------------------------------------
'   UserForm起動時イベント
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    hWnd = FindWindow(vbNullString, Me.Caption)
    hDc = GetDC(hWnd)
    
    Set cFonts = New Collection
    
    'デフォルトフォントの取得
    Call GetDefaultFont

End Sub
Private Sub GetDefaultFont()
    
    Dim lpLogFont As LOGFONT
    Dim hFontTmp As LongPtr
    
    hFontTmp = CreateFontIndirect(lpLogFont)
    hFontDef = SelectObject(hDc, hFontTmp)
 
    cFonts.Add hFontTmp
    
End Sub

'------------------------------------------------------------------
'   UserFormアクティブイベント
'------------------------------------------------------------------
Private Sub UserForm_Activate()

    'テキスト描画はUserFormが表示された後に行う必要があるため
    'InitializeイベントではなくActivateイベントでRepaint後に行う必要あり
    
    Me.Repaint
    
    Dim hFontLeft   As LongPtr
    Dim hFontBottom As LongPtr
    Dim hFontRight  As LongPtr
    
    'フォント設定
    hFontLeft = CreateLogicalFont(13, 90)       '90deg回転
    hFontBottom = CreateLogicalFont(13, 180)    '180deg回転
    hFontRight = CreateLogicalFont(13, 270)     '270deg回転
    cFonts.Add hFontLeft
    cFonts.Add hFontRight
    cFonts.Add hFontBottom
    
    'テキスト描画
    Call DrawText("Left", hFontLeft, 23, 77)
    Call DrawText("Bottom", hFontBottom, 94, 122)
    Call DrawText("Right", hFontRight, 135, 55)

End Sub
'------------------------------------------------------------------
'   テキスト描画
'       sText   :テキスト
'       lpFont  :描画フォント
'       lX      :x座標
'       lY      :y座標
'------------------------------------------------------------------
Private Sub DrawText(ByVal sText As String, ByVal lpFont As LongPtr, _
                     ByVal lX As Long, ByVal lY As Long)
    
    'DCにフォントを設定
    Call SelectObject(hDc, lpFont)
    
    '背景色を透明に設定
    Call SetBkMode(hDc, TRANSPARENT)
    
    'テキスト出力
    Call TextOut(hDc, lX, lY, sText, Len(sText))

End Sub
'------------------------------------------------------------------
'   論理フォント作成
'       lHeight :テキスト高さ
'       lAngle  :テキスト角度(deg)
'------------------------------------------------------------------
Private Function CreateLogicalFont(ByVal lHeight As Long, ByVal lAngle As Long) As LongPtr
 
    Dim lpLogFont As LOGFONT
    Dim hFont As LongPtr
 
    'フォント設定
    With lpLogFont
        .lfHeight = lHeight         '高さ
        .lfEscapement = lAngle * 10 '回転角度
    End With
 
    '論理フォント作成
    hFont = CreateFontIndirect(lpLogFont)
    cFonts.Add hFont
    CreateLogicalFont = hFont
 
End Function

'------------------------------------------------------------------
'   UserForm終了時イベント
'------------------------------------------------------------------
Private Sub UserForm_Terminate()

    Call DeleteAllObjects
    
    Set cFonts = Nothing
    Call ReleaseDC(hWnd, hDc)
    
End Sub
Sub DeleteAllObjects()
 
    Dim hFont 'As LongPtr
    
    '生成したフォント削除
    Call SelectObject(hDc, hFontDef)
    For Each hFont In cFonts
        Call DeleteObject(hFont)
    Next
  
End Sub

コード解説

図形を描画するには下記の手順を行います。

① 描画対象のウィンドウのDCへのハンドルを取得する (GetDC関数)
② フォントの作成 (CreateFontIndirect関数)
③ フォントを描画対象のウィンドウのDCに関連付ける (SelectObject関数)
④ テキストの描画 (TextOut関数, SetBkMode関数など)
⑤ 作成したフォントの削除 (DeleteObject関数)
⑥ DCの解放 (ReleaseDC関数
 

icon-edit 描画対象のウィンドウのDCへのハンドルを取得する

ウィンドウには描画関係の処理を行うためのデバイスコンテキスト(DC)というものが存在します。
このDCを介すことで、ウィンドウ内のピクセル情報を取得したり、図形の描画を行ったりすることが可能になります。DCを取得するにはまず対象のウィンドウのンドルを取得する必要があります。これはウィンドウを識別するためのID情報のようなもので、ハンドルを取得すれば"どの"ウィンドウに対して処理を行うのかを簡単に指示することができます。(Windows APIでは頻出ワードです)

今回はUserFormに回転させたテキストを描画させたいので、UserFormウィンドウのハンドルを取得します。ウィンドウハンドルを取得する方法はいくつも存在しますがここでは常套手段のFindWindow関数を使ってウィンドウハンドルを取得しています。FindWindow関数は下記のように記載することで指定のクラス名もしくはウィンドウ名から該当のウィンドウへのハンドルを取得することができます。(UserFoemの場合はウィンドウ名に「Me.Caption」で取得可能)

icon-code FindWindow関数 

hWnd = FindWindow(クラス名", “ウィンドウ名")

UserFormのウィンドウハンドル取得後、それをそのままGetDC関数に引数として渡せばUserFormの"DCハンドル"を取得することができます。GetDC関数は下記のように記載します。

icon-code GetDC関数 

hDC = GetDC(hWnd)

ここで取得したDCは最終的にメモリから明示的に解放させる必要があるので注意が必要です。
 

icon-edit フォントの作成

WindowsAPIでテキストを描画するにはGDIオブジェクトである論理フォントというものを作成する必要があります。論理フォントを作成するにはCreateFontIndirect関数を使います。

CreateFontIndirect関数は下記のように描画するテキストのフォントに関する情報を格納したLOGFONT構造体を引数として入力することで任意の論理フォントを作成し、そのハンドルを取得することができます。論理フォントで設定できる内容は全部で14種ありますが、ここではテキストの大きさと回転の情報のみを設定します。その他についてはLOGFONTA 構造体(公式ページ)を参照下さい。

icon-code CreateFontIndirect関数 

With lpLogFont
    .lfHeight = lHeight                 '高さ
    .lfEscapement = lAngle * 10   '回転角度
End With
hFont = CreateFontIndirect(lpLogFont)

テキストの回転角度は「lfEscapement」に値を格納しますが、実際の回転角度としてはここに格納された値の1/10の値となります。そのため、上記のように指定の角度から10倍した値を入力しておく必要があります。(※lfOrientationも角度情報ですが文字自体の回転ではありません)
  

icon-edit フォントを描画対象のウィンドウのDCに関連付ける

作成した論理フォントは描画対象のDCと関連付けることで、そのDC内でテキストを描画する際に作成した論理フォントでテキストを描画することが可能になります。これはSelectObject関数を使って下記のように記載することで設定ができます。SelectObject関数はこれまでに取得した描画対象ウィンドウのDCハンドル(hDc)と、描画するための論理フォント(hFont)を引数として渡すだけです。

icon-code SelectObject関数 

hFontBefore = SelectObject(hDc, hFont)

このとき、戻り値であるhFontBeforeは今回関連付けたフォント(hFont)の"前"に関連付けられていたフォントへのハンドルです。初回の実行ではDCにデフォルトで設定されていたフォントへのハンドルが返されます。サンプルコードでは一時的なフォントを作成し、このDCにデフォルトで設定されていたフォントへのハンドルを取得しています(フォントの削除時に使用します)。DCには常に1つのフォントしか関連付けさせることが出来ないため、フォントを変更したい場合は毎回SelectObject関数で関連付けさせているフォントを切り替える必要があります
 

icon-edit テキストの描画

上記までで描画するための設定は完了したので実際にテキストを描画していきます。
まずはSetBkMode関数を使い、下記のように記載してテキスト背景の透過設定を行います。

icon-code SetBkMode関数 

Call SetBkMode(hDc, TRANSPARENT)

第1引数にはDCハンドル(hDc)、第2引数には背景の透過設定の定数値であるTRANSPARENTを入力します。「TRANSPARENT」は該当のヘッダーファイル内に定義されていますが、VBAでは関数の呼び出しを行っているだけなのでこれら定数は定義されていません。そのため「Const TRANSPARENT= 1」というかたちでコードの初めに定義しています。(引数として直接「1」を入力しても可)

背景色の設定が終えたら実際にUserFormにテキストを描画します。
テキストを描画するにはTextOut関数を使い下記のように記載します。

icon-code TextOut関数 

Call TextOut(hDc, lX, lY, sText, Len(sText))

第1引数にはDCハンドル(hDc)、第2,3引数にはテキストを描画するX,Y座標、第4引数には描画するテキスト文字列(sText)、第5引数には文字列の長さをそれぞれ入力します。これにより、指定の座標に入力した文字列のテキストが描画されます。このときのフォントはDCに関連付けられている論理フォントとなります。フォントを切り替えたい場合は前述の通り、SelectObject関数を使って論理フォントの切り替えを行う必要があります。
 

icon-edit フォントの削除

論理フォントは使わなくなった場合、削除してメモリを解放する必要があります。
削除するにはDeleteObject関数を使って下記のように記載します。引数に作成した論理フォントのハンドルを渡すだけです。サンプルコードでは作成した論理フォントのハンドルを一旦すべてコレクションに格納し、UserFormのTerminateイベントで一気に解放していますが、フォントを使わなくなった時点で解放しても問題ありません。

icon-code DeleteObject関数 

Call DeleteObject(hFont)  '※hPenはDCと関連付けられていないこと

注意としてこの関数で論理フォントを削除する際、削除するフォントはDCに関連付けられて"いない"必要がありますつまりは最新でDCに関連付けたフォントは、DCとの関連付けを終了させるまで削除をしてはいけないということです。DCに関連付けているフォントはSelectObject関数で切り替えることができるので、先に保持しておいたデフォルトのフォントをDCに関連付けさせることで作成したフォントをすべて削除することが可能になります。
  

icon-edit DCの解放

論理フォントと同様にDCも使わなくなった場合は明示的にメモリを解放する必要があります。
DCの解放はReleaseDC関数を使って下記のように記載します。引数に解放するDCのハンドルとそのDCを持つウィンドウのハンドルを渡すだけです。

icon-code ReleaseDC関数 

Call ReleaseDC(hWnd, hDc)

関連情報

icon-share-square VBA×WindowsAPIまとめページ

その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。

icon-share-square 参考

Microsoft公式:論理フォントの作成 – Win32 apps
        フォントの作成と選択 – Win32 apps

2025年9月12日Excel,VBA,Windows API