ランチャーソフトを作ってみよう　Step 7　ボタンのフォント色を登録可能にする

ランチャーソフトを作ってみよう

Step 7　ボタンのフォント色を登録可能にする

シートコード

下記のコードに変更してください。

'コマンドボタンクリックイベント
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim sf As String
    Dim ext As String

    '右クリックの場合
    If Button = 2 Then
        ButtonNo = 1
        ButtonCaption = CommandButton1.Caption
        'ファイル指定フォームを開く
        UserForm1.Show
        '見出しをコマンドボタンに表示
        CommandButton1.Caption = ButtonCaption
        CommandButton1.ForeColor = Range("AC" & ButtonNo)
    Else
        sf = Range("AB1")
        ext = ExGetExt(sf)
        ExFileOpen LCase(ext), sf
    End If
End Sub

ユーザーフォームコード

下記のコードを追加してください。

'フォント色ボタン
Private Sub CommandButton4_Click()
    Dim ln As Long
    Dim ret As Boolean
    Dim hwnd As Long

    ln = TextBox1.ForeColor
    'このフォームのハンドルを取得
    hwnd = FindWindow(vbNullString, Me.Caption)
    'カラーダイアログを開く
    ret = ExColorDialog(hwnd, ln)
    If ret Then
        'フォント色をセット
        TextBox1.ForeColor = ln
    End If
End Sub

標準モジュールコード

下記のコードを追加してください。

Private Type COLORSTRUC
  lStructSize As Long
  hwnd As Long
  hInstance As Long
  rgbResult As Long
  lpCustColors As String
  flags As Long
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Const CC_SOLIDCOLOR = &H80

'カラーダイアログ
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
  (pChoosecolor As COLORSTRUC) As Long

'ウィンドウハンドルを取得する
Public Declare Function FindWindow Lib "user32" _
       Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Function ExColorDialog(hwnd As Long, lcol As Long) As Boolean
    Dim ln As Long
    Dim COLS As COLORSTRUC

    COLS.lStructSize = Len(COLS)
    COLS.rgbResult = RGB(255, 255, 255)
    COLS.hwnd = hwnd
    COLS.flags = CC_SOLIDCOLOR
    COLS.lpCustColors = String$(16 * 4, 0)
    ln = ChooseColor(COLS)
    If ln = 0 Then  'Cancel
        lcol = RGB(255, 255, 255)
        ExColorDialog = False
        Exit Function
    Else    'OK
        lcol = COLS.rgbResult
    End If
    ExColorDialog = True
End Function

シートとユーザーフォーム

	「フォント色」ボタンを追加
	「フォント色」ボタンクリックでカラーダイアログが開きます。

Topへ