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

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

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

「フォント色」ボタンを追加


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

スポンサーリンク






メニューに戻る

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved