Excel2000 VBA Face（アイコン）の番号を指定してセルに表示する実験

Excel2000 VBA  Face（アイコン）の番号を指定してセルに表示する実験

Face番号一覧は、http://telstar.blog.so-net.ne.jp/2011-08-14　の記事参照

 

Sub FaceID番号を指定してセルに表示()
'
'inputboxにFaxeID番号を入力し、セルに表示する
'

Dim NoFID As Integer
Dim myCB As CommandBar

'エラーが発生したら
    On Error GoTo Er
'inputboxでFaceID番号取得(1-3518)
    NoFID = Application.InputBox("FaｃeID番号を入力してください。(1-3518)", Type:=1)
        '取得FaceID番号が1-3518の範囲外なら終了
        If NoFID < 1 Or NoFID > 3518 Then
        MsgBox "FaceIDの番号が(1-3518)の範囲外です。" & vbCrLf + vbCrLf & "終了します。"
        Exit Sub
        End If
'コマンドバーの作成と表示
    Set myCB = CommandBars.Add(Name:="FaceID")
    myCB.Visible = True
'Face（アイコン）の設定とコピー
    With myCB.Controls.Add
        .FaceId = NoFID
        .CopyFace
    End With
'シートに貼り付け
    'ActiveSheet.Select
    ActiveSheet.PasteSpecial Format:="ビットマップ", Link:=False, DisplayAsIcon:=False
    GoTo M_End
'エラー処理らしきもの
Er:
    MsgBox "シートに貼り付け出来ませんでした。" & vbCrLf + vbCrLf & "Ctrl+Vで貼り付けてください。"
'終了処理
M_End:
    '作成したコマンドバーの削除
    myCB.Delete
    Set myCB = Nothing

End Sub

 

 

タグ：Excel2000 VBA