項目

再起動しないで外字を設定する

概要

システムで外字を使用している場合があるかと思いますが外字エディタで手動で設定するのは面倒です。
また、VBAでレジストリの値を書きかえただけでは、再起動等をしなくては設定が反映されません。
EnableEUDCを使用して、外字ファイルの使用を停止し、外字ファイルの設定を変更後、
外字ファイルの使用を再開する事により再起動なしで外字を設定する事ができます。

方法

Option Compare Database
Option Explicit

'外字ファイル使用再開/停止設定
Private Declare Function EnableEUDC Lib "gdi32" (ByVal fEnableEUDC As Long) As Long

'レジストリキーをオープンする
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
                        (ByVal hKey As Long, _
                        ByVal lpSubKey As String, _
                        ByVal ulOptions As Long, _
                        ByVal samDesired As Long, _
                        phkResult As Long) As Long

'レジストリキーをクローズする
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'レジストリに値を設定する
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
                            (ByVal hKey As Long, _
                            ByVal lpValueName As String, _
                            ByVal Reserved As Long, ByVal dwType As Long, _
                            ByVal lpData As String, ByVal cbData As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1

Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20

Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
    KEY_NOTIFY Or KEY_CREATE_LINK
    
Private Sub コマンド0_Click()

    Dim rt          As Long
    Dim lpSubKey    As String
    Dim lpValueName As String
    Dim lpData      As String
    Dim hKey        As Long
    Dim cbData      As Long
    
    '外字ファイルの使用停止
    rt = EnableEUDC(0)

    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '停止中に外字ファイルのコピー/レジストリの値設定を行います
    '
    '※１　停止していないと外字ファイルコピー時にエラーが起きます
    '※２　値を設定するキーがない場合には、
    '      HKEY_CURRENT_USER\EUDC\932以下に RegCreateKeyExでキーを作成してください
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    
    '①任意のフォルダへファイルコピー
    
    '・・・省略・・・
    
    '②レジストリの値設定
    'キーオープン
    lpSubKey = "EUDC\932"
    rt = RegOpenKeyEx(HKEY_CURRENT_USER, lpSubKey, 0, KEY_ALL_ACCESS, hKey)
   
    lpValueName = "MS PGothic"                    'MS Pゴシックにフォントをリンクする
    lpData = "c:\temp\gaiji\test.tte"             '外字ファイルのパス
    cbData = LenB(StrConv(lpData, vbFromUnicode))
    
    'レジストリに値を設定する
    rt = RegSetValueEx(hKey, lpValueName, 0, REG_SZ, lpData, cbData)
    
    'レジストリキーをクローズする
    rt = RegCloseKey(hKey)
    
    '外字ファイルの使用再開
    rt = EnableEUDC(1)
    
End Sub