ボタンに画像を使用する

ボタンの作成については、
記事『ボタンを使ってマクロを実行する』を
参照してください。

ボタンに画像を使用するには
画像を使用したいボタンのプロパティの
Pictureの項目で設定します。

矢印のところをクリックすると
画像ファイルの場所をしていするダイアログがでますので、
表示したい画像を指定します。

画像の大きさは、
ボタンのHeightとWidthのプロパティのサイズと同じに作成すれば
うまく表示されると思います。

HeightとWidthのプロパティはポイント単位です。
イラストレーターではポイントでの指定ができますが、
Winのペイントでは
ポイント単位で画像の大きさを指定することはできません。
インチ、センチ、ピクセルのみでした。

ポイントをインチに直してみます。
InchesToPointsメソッドをイミディエイトで実行した結果。

?Application.InchesToPoints(1)
72

1インチ = 72ポイント
つまり、1ポイント = 1/72インチ

例えばボタンの１辺が19.5ポイントなら
この１辺は19.5/72インチです。
Winのペイントは値を計算してくれませんので
計算後の小数を入力してください。

画像の形式はGIFやJPEGなどです。

元の画像とボタン表示された画像を比べると
ボタンに表示されたほうが若干縮小されています。
画像のサイズはボタンに収まるように自動で収縮されます。
このようにボタンいっぱいには表示されません。

ボタンの外枠と画像を表示する部分の大きさは
多少違うようなので
気になる方は画像の大きさを小さくしてください。

上の画像のボタンはJPEG形式の画像を適用しました。
GIF形式の画像を適用すると
色をつけた背景でも透過しました。

ボタンから画像を消すには
Pictureの項目の右側の枠をクリックして
Deleteキーを押してください。

意図したセルを画面の可視範囲に表示

作成途中のプロシージャを試しながら実行しているときに
セルを表示して効果や結果を見ながら順次実行したい時があります。

そのようなとき
Selectメソッドを使えば良いのですが、
他の方法もあります。

Selectメソッドは
ActiveSheetの指定したセルを選択します。
アクティブでないシートの範囲を指定すると
次のようなエラーになります。

実行時エラー'1004':
Range クラスの Select メソッドが失敗しました。

このエラーを回避するには、
まず目的の範囲があるシートをActivateメソッドで
アクティブにしてから Selectメソッドで選択します。

このように2行のコードにしたくないときは
Gotoメソッドを使います。

Gotoメソッドはアクティブでないシートの範囲を指定したとき
そのシートをアクティブにして
指定範囲を画面に表示し、選択します。

使用例：

Application.Goto _
    Reference:=Sheets("Sheet2").Range("A1")

Application.Goto Sheets("Sheet2").Range("A1")

選択せずに指定したセルを表示したいときは、
Showメソッドも使えます。

Showメソッドは、
アクティブシートの中の指定したセルを画面に表示します。
単一のセルを指定します。

使用例：

Range("A1").Show

アクティブシート以外の範囲を指定して
Showメソッドを使ってみましたが、
エラーにはなりませんでした。
この場合は、何もしませんでした。

昇順/降順の並び替えをするボタンを作成

ボタンを作成して、
クリックでマクロを実行、
ボタンに表示されている文字を変更することについては、
記事『ボタンを使ってマクロを実行する』を参照してください。

昇順/降順ボタンとは
中古車のサイトなどで検索すると結果の画面にある
価格や走行距離などで
昇順/降順の並び替えをするボタンのことです。

これをシートの1行目に設置してみます。

まずはボタンを準備します。
1つのボタンで昇順/降順の並び替えをします。
昇順の次は降順、降順の次は昇順のように
交互に実行します。

次に、実際に
昇順/降順の並び替えをするプロシージャを準備します。
このプロシージャは
指定した列(Mycolumn)を基準に、
指定した範囲(MyRange)を並び替えます。

コードはこちら

Sub macro110918a(MyRange As Range, Mycolumn As Range)
'Mycolumnを基準に、MyRangeを並び替えます
'r = 並び替えの範囲
'c = 基準の列
'order =(xlAscending = 1/xlDescending = 2)
    Static order As Integer
      
    'orderを決定
    If order = 2 Then
        order = 1
    Else
        order = 2
    End If
   
    'ヘッダーを含む範囲の並び替え
    MyRange.Sort _
        Key1:=Mycolumn, Order1:=order, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin
   
End Sub

ボタンをクリックして実行するプロシージャのほうは
このようになります。

Private Sub CommandButton1_Click()

    Call macro110918a(UsedRange, Range("A2"))
   
End Sub

macro110918aの1つ目の引数にUsedRangeを、
2つ目の引数にRange("A2")を指定しています。
このボタンはA列の一番上のセルに配置します。

その他の列用のボタンも作成して
macro110918aの2つ目の引数を適宜変えて入力します。
各列のボタンを作成したシートの例はこちら

「s」ボタンを押すとA2:D6の範囲が
押したボタンのある列を基準に昇順/降順に並び替えられます。

ボタンが小さすぎて表示させる文字がsしかできませんでした。
プロパティをじっくり見ましたが項目がなく、
Fontのサイズは変えられない？ようです。

ボタンを使ってマクロを実行する

ボタンを使ってマクロを実行するには、
まずボタンを作成します。

「コントロールツールボックス」のツールバーが
表示されていない場合は、
次の手順で表示してください。

[表示]-[ルーツバー]-[コントロールツールボックス]

「コントロールツールボックス」はこのようなものです。

矢印のところが「ボタン」を作成するマークです。
これを選択して、
ドラッグアンドドロップでボタンを作成します。

上の画像のようになります。
このボタンをダブルクリックすると
このボタンのオブジェクトモジュール↓にジャンプします。

CommandButton1_Clickプロシージャは
先ほど作成したボタンをクリックしたときに実行されます。

ボタンをクリックしたときに
実行したいマクロ(プロシージャ)があるときは、
CommandButton1_Clickプロシージャのなかで
Callステートメント使って呼び出せば実行できます。
次のようにします。

Private Sub CommandButton1_Click()
   
    Call マクロの名前
   
End Sub

これでボタンをクリックすれば
目的のマクロ(プロシージャ)が実行されます。

もう一つボタンに関して最低限設定しておきたいところは
ボタンに表示される文字です。
「コントロールツールボックス」の
プロパティを選択してください。

すると、プロパティが表示されます。

上の画像は、[項目別]のタブを選択した状態です。
矢印の[Caption]の値は「CommandButton1」になっています。
この値がボタンに表示される文字です。
[Caption]の値を「マクロ実行」にすると
ボタンに表示される文字も変わります。

もし、[プロパティ]選択できない時は、
デザインモードでない可能性があります。
そのときは、「コントロールツールボックス」の左上の
三角定規のボタンをクリックしてデザインモードにしてください。

以上、最小限のボタン入門講座でした。

虫食い2

記事『虫食い』、
『値によってセルを色分けする』で使用したプロシ ージャを
再び変更して使用してます。

今回はカラーパレットをインデックス順に
カラースケール（レインボー）に
変更したものを使います。

カラースケールにパレットを変更するコードはこちら

Sub macro110911a()
'カラーパレットを変更
'色相のグラデーション
'ColorIndex順

    Dim i, r, g, b As Integer
    Dim MyIndex As Variant
        MyIndex = Array(1, 2, 3, 4, 5, 6, 7, 8, _
            9, 10, 11, 12, 13, 14, 15, 16, _
            17, 18, 19, 20, 21, 22, 23, 24, _
            25, 26, 27, 28, 29, 30, 31, 32, _
            33, 34, 35, 36, 37, 38, 39, 40, _
            41, 42, 43, 44, 45, 46, 47, 48, _
            49, 50, 51, 52, 53, 54, 55, 56)
            
        For i = 0 To 9
            r = 255
            g = Int(255 * i / 9)
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 10 To 19
            r = Int(255 - (255 * (i - 9) / 10))
            g = 255
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 20 To 28
            r = 0
            g = 255
            b = Int(255 * (i - 19) / 9)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 29 To 37
            r = 0
            g = Int(255 - (255 * (i - 28) / 9))
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 38 To 46
            r = Int(255 * (i - 37) / 9)
            g = 0
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 47 To 55
            r = 255
            g = 0
            b = Int(255 - (255 * (i - 46) / 9))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

今回の規則は、
「セルを一回通るごとにColorIndexを+1する」
というものです。

ColorIndexは56までですので、
Switch関数で56以上にならないように
してあります。

コードはこちら

Sub macro110911b()
'虫食い2

    Application.ScreenUpdating = False
    Sheets.Add
   
    Dim i As Long
    Dim cIndex As Integer
    Dim MyRange As Range
    Dim r As Range
    Set r = Selection
   
    ' セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
    Cells.Interior.ColorIndex = 1
   
    For i = 0 To 1000000
'        r.Select
        Select Case Int(Rnd * 4)
            Case 0
                If r.Row + 1 < Rows.Count Then
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(1, 0).Interior.ColorIndex = _
                        Switch(cIndex = 56, 56, True, cIndex + 1)
                    r.Offset(1, 0) = r.Offset(1, 0) + 1
                    Set r = r.Offset(1, 0)
                End If
            Case 1
                If r.Column + 1 < Columns.Count Then
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(0, 1).Interior.ColorIndex = _
                        Switch (cIndex = 56, 56, True, cIndex + 1)
                    r.Offset(0, 1) = r.Offset(0, 1) + 1
                    Set r = r.Offset(0, 1)
                End If
            Case 2
                If r.Row - 1 > 0 Then
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(-1, 0).Interior.ColorIndex = _
                        Switch(cIndex = 56, 56, True, cIndex + 1)
                    r.Offset(-1, 0) = r.Offset(-1, 0) + 1
                    Set r = r.Offset(-1, 0)
                End If
            Case 3
                If r.Column - 1 > 0 Then
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(0, - 1).Interior.ColorIndex = _
                        Switch (cIndex = 56, 56, True, cIndex + 1)
                    r.Offset(0, - 1) = r.Offset(0, -1) + 1
                    Set r = r.Offset(0, -1)
                End If
        End Select
    Next i
   
    Application.ScreenUpdating = True
   
End Sub

実行後のシートの例：

ジャクソンポロック系？炎？

デフォルトのカラーパレットでは
なにかポップな印象でした。

いろいろなカラーパレットで試してみましたが
面白いです。

セルの高さの自動変更をなくす

手動でもVBAでも
セルに複数行の文字列を入力すると
セルの高さが自動で変更されます。

何十行になる文字列を入力すると
1つのセルで画面の縦一杯になってしまって
とても見にくく扱いづらくなることがあります。

Excel本来の使用目的は
そのようなことではないのでしょうがないですが。

実は、
手動で高さを変更したことがあるセルは、
複数行を入力したときでも
セルの高さは自動で変更されません。
これは仕様です。
参：Wrap text does not adjust row height in Excel

この仕様を使って、
この複数行を入力したとき
セルの高さの自動変更をなくしたいと思います。

つまり、
シートを挿入したらすぐに
すべてのセルの高さを変更すれば
それ以降セルの高さが自動で変更されることはなくなる
ということです。

コードはこちら

Sub macro110910a()
'セルの高さの自動変更をなくす

    Sheets.Add
   
    '標準の高さに変更
    Cells.RowHeight = ActiveSheet.StandardHeight
   
    '試しに複数行を入力
    Cells(1, 1) = "aaaaaaaaaaaaaaaa" & Chr(10) & _
        "aaaaaaaaaaaaaaaa" & Chr(10) & _
        "aaaaaaaaaaaaaaaa" & Chr(10) & _
        "aaaaaaaaaaaaaaaa" & Chr(10) & _
        "aaaaaaaaaaaaaaaa" & Chr(10) & _
        "aaaaaaaaaaaaaaaa"
       
End Sub

上のコードで挿入されたシート：

セルの表示と実際の文字列を見るとわかるように
セルの高さは自動で変更されていません。

これを試行しているときに、

セル内の改行はあっても
[セルの書式設定]で[折り返して全体を表示する]のチェックを外すと
表示上は改行がなくなる。

ということを知りました。

あるあるエラー：オブジェクト変数

オブジェクト変数に
シートや範囲のなどオブジェクトを入れようとしたとき
次のようなエラーになったことはありませんか？

どこにも間違いがないように見えるコードで
エラーになります。
どこが分からなくて途方にくれます。

さて、Setステートメントはご存知ですか？
変数とオブジェクト変数があることを知っていれば
Setステートメントも知っていると思います。

誰かが作ったコードを切り貼りして応用していると
オブジェクト変数を知らないで
オブジェクト変数を使っていることがあります。

そのような段階でこのエラーが起こると
エラーの理由が分りません。

値をいれる変数と違って
オブジェクト変数に値を代入するには
Setステートメントを使います。

これは、慣れても忘れることしばしばあります。

次のコードがエラーになるコード例：

Dim sh As Object
sh = Sheet1

こちらがエラーにならないコード例：

Dim sh As Object
Set sh = Sheet1

Sheet1を代入するところでSetステートメントを使っています。

余談ですが、
値を入れる変数にもSetステートメントに似た
Letステートメントがあります。
Basicを知っているひとにはお馴染みです。
大学入試センター試験の数学プログラム問題でも
1回は出てきます。

このLetステートメントはVBAでは省略可能なため
存在を知らない人も多いと思います。

BasicフレイヴァーでVBAをしたいなら必須です。

Withを使うか、オブジェクト変数を使うか

Withステートメントを使うと入力を省略できます。
例えば次のようなコードについて説明します。

Sheets("Sheet1").Cells(1,1) = 1
Sheets("Sheet1").Range("A2") = 2

このコードをWithステートメントを使うと
次のコードのように入力できます。

With Sheets("Sheet1")
    .Cells(1,1) = 1
    .Range("A2") = 2
End With

これをオブジェクト変数を使ってやってみます。

Dim sh As Object
Set sh = Sheets("Sheet1")
sh.Cells(1,1) = 1
sh.Range("A2") = 2

個人的には上から順番に
コードの仕方が変わってきました。
WithはJavaにはなかったのでスルーしていましたが、
使えば便利です。

しかし、Withステートメントは入れ子状に使うので
その中のコードが長くなるとき見にくくなるので、
最近は避けるようになりました。
またIf文のような中でWithを使うと
何重にも入れ子になり見にくくなると思います。

このような理由でオブジェクト変数を使うのを好みます。

大体の処理や操作は
A → B
なので汎用のオブジェクト変数が2つあれば
たくさん変数を宣言しなくても対応できます。

例えば、"Sheet1"シートのセルA1の値を
"Sheet2"シートのセルC1の値に代入するときこのようにします。

Dim sh1 As Object
Dim sh2 As Object
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

sh2.Range("C1") = sh1.Range("A1")

もう一つWithステートメントの使いにくいところを挙げると、
デバッグモードのときに
Withの中のコンマで始まる個所を変更できないことです。
変更しようとすると
次のようなダイアログが出て終了しなければいけません。

現時点での方針は、
扱うオブジェクトが少ない、つまり
WithとEnd Withの間が短くて済む場合は
Withステートメントを使います。
そのほかの場合はオブジェクト変数を使います。

本ブログを参考にする場合、
この事を頭の片隅に置いて読むと理解しやすいかと思います。