一つ飛びにセルを選択する（Ｅｘｃel2002以降)

さて、今日は、生徒さんの要望を取り上げます。

友人から、以下のようなデータを受け取るらしいのですが、
気温と湿度が交互になっているとのこと。

そこで、気温のデータのセルを簡単に選択できないか、とのリクエストです。





「なるほど、それなら、ひとつおきにセルを選択できれば、気温だけを選択できるし、
湿度だけを選択することもできますね。」

「選択したら、コピーをして、どこかに貼り付けると、データが連続するんですよ。」

「そうすると、気温のデータと湿度のデータにきちんとわけられますね。」

「何とかなりますか。手動では、手間がかかるんですよね。」

「分かりました。こんな時は、やはり、ＶＢＡを使いましょう。」



そんなわけで、さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。
「挿入」→「標準モジュール」をクリックします。
これで、コードを記述する準備が整いました。

それでは、次のようにコードを書いてみてください。

Sub 飛び石選択()
    Dim a() As Variant
    Dim TargetColumn As Integer
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim s As String
    Dim i As Integer
    
    '選択された列の番号をアルファベットに変換するための配列
    a = Array("0", "A", "B", "C", "D", "E")
    '列番号を取得
    TargetColumn = Selection.Column
    '開始の行番号を取得
    StartRow = Selection.Row
    '終了位置の行番号を取得
    LastRow = Selection.End(xlDown).Row
    '一つおきにセル位置を文字列として設定
    For i = StartRow To LastRow Step 2
        s = s & a(TargetColumn) & i & ","
    Next
    '文字列の最後のコンマを削除
    s = Left(s, Len(s) - 1)
    '下の行頭のコンマを削除すると、
    '生成された文字列を確認できます。
    'MsgBox s
    
    '文字列をセル範囲として使います
    Range(s).Select
End Sub

一応画像も載せておきます。





セルを選択するだけなのに、コードは苦労しました。
なお、今回は、選択されたセルを基準に、下方向に一つ飛びにセルを選択するようにしました。
したがって、まず基準のセルを選択してから、コードを実行してください。


それでは、Excelに切り替えてください。

C2を選択してください。このセルを基準として、下方向にひとつおきにセルを選択します。

それでは、プログラムを実行してみましょう。


Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。

今回記述したマクロ（プロシージャ）を選択して、実行ボタンをクリックします。





すると、気温のデータだけ、選択できました。




C3を選択してからこのプロシージャを実行すると、湿度のデータだけを選択することができます。

※データ以外のセルを選択してから実行すると、エラーとなります。
エラー対策は、各自考えてみてくださいね。


だい

条件分岐について（If構文 と Select Case構文 を使ってみよう)

今日は、VBAの条件分岐について確認してみたいと思います。

条件分岐には、2つの書き方があります。ひとつは、If構文を使う方法、そしてもう一つは、
Select Case構文を使う方法です。

一般的には、条件分岐が少ない時は前者、多い時は後者を使うと分かりやすいです。

例えば、以下のケースを考えてみましょう。

収入金額が、
8,000円以下の場合は、基礎控除は0円。
8,340円未満の場合は、基礎控除は8,340円。
12,000円未満の場合は、基礎控除は9,030円。
12,000円以上は、基礎控除はxxx円。
※基礎控除額は、全て仮定です。実際の額ではありません。

このような場合、条件分岐の数が多いので、まずは、Select Case構文を使ってコードを記述してみましょう。

Sub test2()
    Dim intValue As Integer
    
    intValue = InputBox("収入金額を入れてください")

    Select Case intValue
        Case Is <= 8000
            MsgBox "基礎控除は0円です"
        Case Is <8340<br>
            MsgBox "基礎控除は8340円です"
        Case Is <12000<br>
            MsgBox "基礎控除は9030円です"
        Case Else
            MsgBox "基礎控除はXXX円です "
    End Select
End Sub

Select Case構文の場合、最初の条件から順次チェックしていきます。
従って、収入金額が8,200円の場合は、最初の条件つまり、8,000円以下を満たしていないため、次の条件に移ります。
2番目の条件8,340円未満を満たしているので、「基礎控除は8340円です」というメッセージボックスが表示されます。

下の図は、上記のサブルーチンを実行したところです。



8200と入力して、OKボタンを押すと、以下のメッセージが表示されます。
正しく動作していますね。






さて、同じ内容をIf構文を使って書いてみましょう。

Sub test()

    Dim intValue As Integer

    

    intValue = InputBox("収入金額を入れてください")

    

    If intValue <= 8000 Then

        MsgBox "基礎控除は0円です"

    ElseIf intValue > 8000 And intValue <8340 Then<br>

        MsgBox "基礎控除は8340円です"

    ElseIf intValue >= 8340 And intValue <12000 Then<br>

        MsgBox "基礎控除は9030円です"

    ElseIf intValue >= 12000 Then

        MsgBox "基礎控除はXXX円です "

    End If

End Sub

条件指定が、少し複雑だと感じませんか？


どちらも正しく動作します。好みもあるかもしれませんが、できるだけ、分かりやすいコーディングを
心がけることも大切ですね。



だい

半角英数自動大文字変換システム(Excel2002以降)

今日も、生徒さんからの質問にお応えしましょう。

「先生、B列に商品コードを入力するときに、自動的に日本語入力システムをOFFにできたら、楽なんですけど。」

「ほう、なるほど、注文書を作っているんだね。そんなときは、こうしましょう。」




B4:B8を選択して、「データ」メニューの「入力規則」をクリック。




「データの入力規則」ダイアログボックスの「日本語入力」タブをクリック。
一覧から、「オフ（英語モード）」を選択して、「OK」をクリック。
これで、B4:B8のセルを選択すると、自動的に、日本語入力システムをOFFになります。



「本当だ。これなら入力時に、いちいち言語バーを気にする必要がなくて楽ですね。」

「そうですね。よかったですね。」

「でも先生、商品コードは、英語の大文字と数字の組み合わせなんですよ。自動的に大文字入力に切り替えられると
うれしいなあ。」

「残念ながら、そんな機能はないですね。でも、VBAを使えば、何とかなりますよ。」



そんな訳で、さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。

左にある、プロジェクトエクスプローラの中の、Sheet1をダブルクリックします。
（今回の表がSheet1にあるという前提です）
すると、コードウィンドウが表示されます。
その上にある、左右二つのリストから、左側Worksheet　右側Changeを選択してください。

すると、
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
というコードが自動的に記述されますので、以下を参考に、コードを入力してください。

なお、左側Worksheet　右側SelectionChangeを選択するともう一つのサブルーチン（イベントプロシージャ）が
自動的に記述されます。

なお、以下のコードの最初の2行は、必ず、サブルーチンよりも上に書いてください。

Option Explicit
Private i As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
    Const STD As Integer = 2
    
    With Target
        If .Column = STD Then
            On Error GoTo eh
            If i > 0 Then Exit Sub
            i = i + 1
            .Value = UCase(.Value)
'            Debug.Print .Value
        End If
    End With
    Exit Sub
eh:
    
End Sub


Private Sub Worksheet_SelectionChange( _
                        ByVal Target As Range)
    i = 0
End Sub

参考までに画像も載せておきます。





メインの処理は、Ucase関数を使って、大文字に置き換える1行です。
その割には、まわりくどいコードのように見えますね。

実は、大文字に変換した途端、このイベントプロシージャが再度実行されてしまうのです。
繰り返し実行される回数をカウントしたら、227回でした。
明らかに無駄な処理なので、この無駄を回避するために、コードが長くなりました。

それでは、Excelに切り替えてください。
プログラムを確認してみましょう。


なお、今回は、マクロを実行する必要はありません。
B列に入力すると、自動的にプログラムが実行されます。
これを、イベントプロシージャといいます。

例えば、B4に、a002 と入力して、Enterキーを押すと・・・




自動的に、A001　と、大文字に変換されます。





「なるほど、こんなこともできるんですね。なんだか楽しいなあ」

「何よりです。」

「先生もエクセルを見習って、しっかり働いてくださいよ。」

「な、何てことを！・・・」



だい

コメントの一括削除(Excel2003)

今日は、生徒さんからのリクエストにお応えしましょう。

「先生、このシートには、たくさんのコメントが挿入されているんですよ。」

「それは賑やかですね。いくつくらい？」

「ざっと、100くらいですか。」

「それは、すごい。でも、必要なんでしょ。」

「私が、コメントを挿入したんじゃないんですよ。前任者から渡されたファイルなんですよ。
しかも、不要なコメントばかりで、全部削除したいんですよ。」

「がんばって、削除してください。セルを右クリックして『コメントの削除』をクリックしてくださいよ。」

「また、そうやってからかう。やりきれたもんじゃないですよ。助けてください。」

「ははは、冗談。分かりました。お手伝いしましょう。」


そんな訳で、今回は、下のような表があるとしましょう。






C列には、3つのコメントが設定されています。ひとつご覧いただきましょう。




これらのコメントを、一度に削除するプログラムを作ります。

さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。
「挿入」→「標準モジュール」をクリックします。
これで、コードを記述する準備が整いました。

それでは、次のようにコードを書いてみてください。

Sub DeleteComments()
    Dim r As Range
    
    '表内の各セルについて繰り返し処理
    For Each r In Range("B2").CurrentRegion
        'コメントのないセルに対して削除エラーのトラップ
        On Error Resume Next
        'コメントの削除
        r.Comment.Delete
    Next
    
End Sub

一応画像も載せておきます。



今回は、複雑な処理はありません。
セルを一つずつピックアップして、コメントを削除するだけです。
ただ、コメントのないセルに対しては、エラーが発生するので、
エラーのトラップを忘れないようにしてください。


それでは、Excelに切り替えてください。
プログラムを実行してみましょう。


Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。

今回記述したマクロ（プロシージャ）を選択して、実行ボタンをクリックします。




すると、瞬時に全てのコメントが削除されました。



「先生、ありがとう。助かりましたよ。」

「どういたしまして。それはそうと、コメントの背景の色は、自由に設定できるってご存知でした？」

「もちろんですよ。何となれば、画像だってコメントに入れられますよ。」

「さすが勉強家。たいしたもんだ。」

「いえいえ、まだまだ。」

「何をおっしゃる、うさぎさん。」

「いやいや。」


こうして、たわいもない会話が続くのでした。


だい

指定した文字列を、セルに1文字ずつ表示(Excel2000以降）

今日は、指定した文字列を、セルに1文字ずつ表示してみます。

例えば、A列2行目に適当な文字列を入力してください。
今回は、「パソコンカレッジ」と入力しました。

マクロを実行すると、4行目の1列目から順番に1文字ずつ表示されます。




何の意味があるの？
そんなことは言わないで。気分転換にプログラミングしてみましょうよ。
Excel VBAを使いましょう。

さて、さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。
「挿入」→「標準モジュール」をクリックします。
これで、コードを記述する準備が整いました。

それでは、次のようにコードを書いてみてください。

Sub typewriting()
    Dim data As String
    Dim i As Integer
    Const r As Integer = 4  '表示する行番号を指定
    
    'まず、クリア
    Cells(r, 1).CurrentRegion.Clear
    '文字列を変数に格納
    data = Range("A2").Value
    '一文字ずつセルに表示するメイン処理
    For i = 1 To Len(data)
        Cells(r, i).Value = Mid(data, i, 1)
        '1秒待つ
        Application.Wait Now + TimeValue("00:00:01")
    Next
End Sub

一応画像も載せておきます。




コードの解説は、プロシージャ内のコメントをご覧ください。

文字列の任意の位置の文字を取り出すには、MID関数を使います。
1文字目から、順次1文字ずつ取り出していきます。
ちなみに、文字列の左から指定した文字数を取り出すには、LEFT関数を、
文字列の左から指定した文字数を取り出すには、RIGHT関数を使います。

それでは、Excelに切り替えてください。
プログラムを実行してみましょう。


Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。

今回記述したマクロ（プロシージャ）を選択して、実行ボタンをクリックします。


今回は、1秒経過したら、1文字ずつ表示するようになっています。




セルに1文字ずつ表示されていきますよ。




それでは、また。



だい

最大公約数を求めるユーザー定義関数(Excel2000以降）

さて、今回は、最大公約数を求める関数をExcelVBAでプログラミングしてみましょう。

２つの整数の最大公約数とは、両方の数をあまりなく割り切れる数のうち一番大きいもののことです。
１２と１８は両方とも２で割れます。３でも割れます。６でも割れます。
一番大きいものは６なので最大公約数は６となります。

最大公約数を求める方法として有名なものは、「ユークリッドの互除法」です。

フリー百科事典『ウィキペディア（Wikipedia）』には、「明示的に記述された最古のアルゴリズムとしても知られ、
紀元前300年頃に記されたユークリッドの『原論』第 7 巻、命題 1 から 3 がそれである。」とあります。

頭のいい人は、はるか昔からいたんですよね。ほんとうにすごい。

さて、どんな方法なのかですが、「2 つの自然数（または整式） a, b (a ≧ b) について、a の b による剰余を r とすると、
a と b との最大公約数は b と r との最大公約数に等しいという性質が成り立つ。この性質を利用して、 b を r で割った剰余 除数 r を
その剰余で割った剰余、と剰余を求める計算を逐次繰り返すと、剰余が 0 になった時の除数が a と b との最大公約数となる。」とのことです。

詳しくは、『ウィキペディア（Wikipedia）』をご覧ください。


さっそく、コードを書いてみましょう。

エクセルを起動して、Alt + F11 で、Visual Basic Editorを起動します。

挿入メニューの「標準モジュール」をクリックすると、コードを入力することができます。

以下のようにコードを記述してください。

Function Kouyakusu(x As Integer, y As Integer) As Integer
    
    If x Mod y = 0 Then
        Kouyakusu = y
        Exit Function
    End If
    Kouyakusu = Kouyakusu(y, x Mod y)

End Function

画像も載せておきます。



Functionで始まるプロシージャは、ユーザー定義関数となります。

関数名は、Kouyakusu　です。冴えない名前ですみません。
コードのポイントは、ユークリッドの互除法を再帰呼び出しで実現しているところです。
もちろん、繰り返し処理でも実現できますが、このほうが、シンプルです。

また、ユークリッドの互除法では、大きい数を小さい数で割るところから始まりますが、別に逆でもかまいません。
1回繰り返し処理が増えるだけのことです。

それでは、早速実行してみましょう。

エクセルに切り替えてください。

以下のような設定を前提として進めます。
つまり、B2とB3に、任意の自然数を入力します。数の大小は気にしなくて結構です。
D2に、先ほど作ったユーザー定義関数を入力してください。引数は、B2とB3になります。




すると、即座に答えが表示されます。これが関数のすごいところですね。
B2、B3の数字を変更した途端、D2に、自動的に最大公約数が表示されますよ。





ユークリッド万歳！！




だい

100個のセルにランダムに番号を振る-その3(Excel2000以降）

さて、今回も「100個のセルにランダムに番号を振る」を取り上げます。

バックナンバーはこちら。
100個のセルにランダムに番号を振る
100個のセルにランダムに番号を振る-その2

僕は、今まで、以下の考え方でコードを考えてきました。
1.ランダムにセルを指定し、そのセルに1から順番に数字を入力する。
2.指定されたセルに既に数字が入力されている場合は、無視し、空白のセルが見つかったら、数字を入力する。


ところが、愚石さんから質問を受けました。
「左上のセルから順番にランダムな数を入力していく方法は大変なのか？」


確かにそういう考え方もできますよね。
つまり、
1.A列1行目から最終セルまで、順番に繰り返し処理をする。
2.ランダムな数字を発生させて、その値をセルに入力する
3.既に使用している数字の場合は、未使用の数字になるまでランダム数を発生させる


この場合、3の処理がポイントとなります。
全てのセルに対して、今回のランダム数が未使用なのかチェックするとすると、
またしても、繰り返し処理をしなくてはなりません。
繰り返し処理の中に繰り返し処理が入ってくると、どんどん処理が遅くなってしまいます。
ここをどうするのか？

考えること○時間、ようやく妙案を思い付きました。

未使用か既使用かを判断するための配列を活用すればいい。
セルの数の分だけの要素をもった配列を用意します。
そして、セルに入力した数字をインデックスとした要素にマークを付けます。
そうすれば、その数字が未使用かどうか、そのインデックスの値を見ればすぐにわかります。

例えば、ランダムに発生した数字が2とします。
この場合、配列の最初から2番目の要素に、目印であるTrueという値を代入します。
以降、もし、ランダムに発生した数が2だとしても、配列の2番目の値を参照して、そこにTrueが入っていれば、
使用済みということが即座に分かります。
（厳密には、配列のインデックスは0から始まるので、3番目となります）

Sub Numbering2()
    Dim t As Integer
    Dim r As Integer, c As Integer
    Dim checkArray() As Boolean
    Dim s As Double, e As Double
    Const ROW_NUM As Integer = 20
    Const COLUMN_NUM As Integer = 10
    
    '以前の数字をクリア
    Range("A1").CurrentRegion.ClearContents
    
    '未使用かどうかを判定する配列
    '要素数は、行列数で変化するので、ここで定義する
    ReDim checkArray(ROW_NUM * COLUMN_NUM)
    
    '乱数ジェネレータを初期化（これで本当に乱数が発生する）
    Randomize
    For c = 1 To COLUMN_NUM
        For r = 1 To ROW_NUM
            Do
                t = Int(Rnd() * (ROW_NUM * COLUMN_NUM)) + 1
            Loop Until checkArray(t) = False
            Cells(r, c).Value = t
            checkArray(t) = True
        Next
    Next
    '配列の値は、以下のコードによって、
    'イミディエイトウィンドウで確認できます（表示メニューから）
    For i = 0 To UBound(checkArray)
        Debug.Print i & ":" & checkArray(i)
    Next
End Sub

画像も載せておきます。




それでは、実行してみましょう。以下が実行結果です。

うまくいってますよね。それに、処理速度も問題なさそうですよ。



ちなみに、Visual Basic Editorの表示メニューから、イミディエイトウィンドウを表示させると、以下のように、
配列の値を見ることができますよ。
以下の画像は、画面の制約上、配列の一部ですが、みんな使用済みのTrueが入っているのがお分かりいただけます。




だい

100個のセルにランダムに番号を振る-その2(Excel2000以降）

さて、今回は、前回の記事のコメントにお答えします。

ちなみに前回は、「100個のセルにランダムに番号を振る」というものでした。

頂きましたコメントは、「１から２００までの数字を１０行２０列に表示するならどうなるんだろう？」です。

さっそくコードを修正してみましょう。

以下のように修正してください。

Sub Numbering()
    Dim i As Integer
    Dim r As Integer
    Dim c As Integer
    Const MAX_NUM As Integer = 200
    
    '以前の数字をクリア
    Range(Cells(1, 1), Cells(MAX_NUM, MAX_NUM)).ClearContents
    
    i = 1
    '乱数ジェネレータを初期化（これで本当に乱数が発生する）
    Randomize
    '今回は100になるまで繰り返し処理
    Do Until i = MAX_NUM + 1
        '乱数で行番号と列番号を取得
        r = Int(Rnd() * 20) + 1
        c = Int(Rnd() * 10) + 1
        '既に入力されているセルには書き込まない
        If Cells(r, c).Value = "" Then
            Cells(r, c).Value = i
            i = i + 1
        End If
    Loop
End Sub

変更箇所を赤く囲っておきました。
乱数を発生させる部分と最大数を指定する部分の2つですよ。




それでは、実行してみましょう。以下が実行結果です。
うまくいきましたね。（塗りつぶしの色は前回の名残です。気にしないでください）




さあ、こうなると、行数・列数を何回も変更して試してみたくなりますよね。

そこで気が付きました。
行数と列数を指定するだけで、何とかならないものだろうか？

何とかなりました。
以下が、変更後のコードです。

Sub Numbering()

    Dim i As Integer

    Dim r As Integer

    Dim c As Integer

    Const ROW_NUM As Integer = 20

    Const COLUMN_NUM As Integer = 5

    

    '以前の数字をクリア

    Range("A1").CurrentRegion.ClearContents

    

    i = 1

    '乱数ジェネレータを初期化（これで本当に乱数が発生する）

    Randomize

    '今回は100になるまで繰り返し処理

    Do Until i = ROW_NUM * COLUMN_NUM + 1

        '乱数で行番号と列番号を取得

        r = Int(Rnd() * ROW_NUM) + 1

        c = Int(Rnd() * COLUMN_NUM) + 1

        '既に入力されているセルには書き込まない

        If Cells(r, c).Value = "" Then

            Cells(r, c).Value = i

            i = i + 1

        End If

    Loop

End Sub

変更箇所を赤線で示しておきました。




このようにコードを修正しておけば、今後は、赤い枠の中の数字を変更するだけで、簡単に任意のマス数のランダム配置ができます。

つまり、
Const ROW_NUM As Integer = 20
が、行の数を指定しています。
Const COLUMN_NUM As Integer = 5
が、列の数を指定しています。
この数字を自由に変更してください。それだけで、けっこうです。

たとえば、上記のようにすると、行数が20、列数が5 の計100までの数字がランダムに配置されます。

実行結果は以下のとおりです。





メイン処理のコード部分を変更することなく、コード冒頭の定数だけを変更すればいいので、今回のコードは、変更に強い書き方といえましょう。


だい

100個のセルにランダムに番号を振る(Excel2000以降）

今日は、長男のリクエストを取り上げます。

「数字を適当に並べてほしい」というのがそのリクエストです。

今回は、エクセルを使ってお応えしましょう。

10×10=100のセルを使って、ランダムに1から100までの数字でセルを埋めていきます。

以下のような感じです。
毎回、ランダムに数字が配置されますよ。
（なお、100個のセル範囲には、事前にセルの塗りつぶしを設定しておきました）




さて、さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。
「挿入」→「標準モジュール」をクリックします。

そこに、次のようにコードを記述してください。

-------------------------------------------------------

Sub Numbering()
    Dim i As Integer
    Dim r As Integer
    Dim c As Integer
    Const MAX_NUM As Integer = 100
    
    '以前の数字をクリア
    Range(Cells(1, 1), Cells(MAX_NUM, MAX_NUM)).ClearContents
    
    i = 1
    '乱数ジェネレータを初期化（これで本当に乱数が発生する）
    Randomize
    '今回は100になるまで繰り返し処理
    Do Until i = MAX_NUM + 1
        '乱数で行番号と列番号を取得
        r = Int(Rnd() * 10) + 1
        c = Int(Rnd() * 10) + 1
        '既に入力されているセルには書き込まない
        If Cells(r, c).Value = "" Then
            Cells(r, c).Value = i
            i = i + 1
        End If
    Loop
End Sub

-------------------------------------------------------

一応、画像も載せておきますよ。




コードの解説は、プロシージャ内のコメントをご覧ください。

それでは、実行してみましょう。

Excelに切り替えて、Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。

実行ボタンをクリックします。





新たに1から100までの数字がランダムに配置されましたね。





今回は、10行×10列のセル範囲としましたが、変更した場合、コードのどこを変更したらいいのか考えてみてくださいね。



だい

宛名を変えて自動的に連続印刷する方法-その2-(Excel2000以降）

今日は前回（宛名を変えて自動的に連続印刷する方法）の続きです。


さて、前回の最後に書きましたが、連続印刷の場合、プリンタによっては、一度に大量のデータを送りつけられると
エラーとなって印刷できない危険性があります。

そんなリスクを回避するために、コードを追加します。
以下のように変更してください。

Sub 連続印刷()
    Dim i As Integer
    Dim LastRow As Integer
    Const UNIT As Integer = 5
    
    Worksheets("発注書").Select
    
    With Worksheets("名簿")
        LastRow = .Range("A65536").End(xlUp).Row
        For i = 2 To LastRow
            If i Mod UNIT = 0 Then
                MsgBox "一定数印刷されたらOK押してね"
            End If
            Range("A4").Value = .Range("A" & i).Value
            ActiveSheet.PrintPreview
        Next
    End With
End Sub

追加個所は、赤枠で囲ったところですよ。




UNITという定数に5を設定しました。
この数字の倍数のときに、メッセージボックスが表示されます。
表示されている間は、印刷データがプリンタに送られません。

ある程度印刷された段階で、このメッセージボックスのOKを押してください。
すると、また、UNITに設定された数だけ（今回なら5回分）印刷データを送り込んで、メッセージボックスが表示されます。

こうして、一度に大量のデータを送信することを回避しているのです。


それでは、実行してみましょう。

Excelに切り替えて、Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。
実行ボタンをクリックします。





今回のコードは、実際に印刷するのではなく、印刷プレビューとなります。
5回プレビューされるとメッセージボックスが表示されます。
（厳密に言うと、最初のメッセージボックスは、5回よりも少なくなります）







メッセージボックスのOKを押すと、5回プレビューして、再度メッセージボックスが表示されます。


ちなみに、UNITの5 を変更すると、その数字分だけ印刷してメッセージボックスが表示されます。
いろいろと試してみてください。


だい

一定時間間隔で文字を次々に表示する(Excel VBA)

さあ、新しい一週間の始まりですね。

今日は、ExcelVBAを使って、セルに入力された値を、タイプライターのように
1秒ずつ順次表示していくプログラムをご紹介します。

たとえば、B列2行目に「おはよう」と入力してから実行すると、次のように表示されます。




1病後・・・





1病後・・・



ってな、感じで、表示されていくのです。



さて、さっそくコードを書いてみましょう。


ALT + F11 で、VisualBasicEditorを起動します。

「挿入」→「標準モジュール」をクリックします。

そこに、次のようにコードを記述してください。

Sub typewriting()
    Dim s As String
    Dim i As Integer
    Dim t As Double
    
    Range("B5").Value = ""
    t = Range("B7").Value / 24 / 60 / 60
    s = Range("B2").Value
    For i = 1 To Len(s)
        DoEvents
        Application.Wait Now + t
        Range("B5").Value = Mid(s, 1, i)
    Next
End Sub

画像も載せておきます。




コードの簡単な解説です。

mid関数は、指定した位置から指定した分の文字列を取得する関数です。

Application.Wait　を使うと、指定した時間だけ処理を待ちます。




それでは、エクセルに切り替えて、F5キーを押して確認してください。


今回は、B列7行目に秒数指定ができますよ。
2と入力すると、2秒おきに文字が増えていきます。


なお、同様のプログラムをVisual Basic でやろうと思うと、これまた一筋縄ではいかないのであります。

それは、またの機会に・・・

だい

すべての画像を一括削除する方法(Excel2002以降）

さて、今日も、生徒さんからの質問を取り上げます。

学校の職員をされているので、書類をたくさん作成しているのですが、
前任者から引き継いだエクセルファイルに、たくさんのオートシェイプが使用されていて、
しかも、そのオートシェイプが、限りなく小さくなっているので、
どこに存在するのか見つけることが出来ないそうです。

これらのオートシェイプをとにかくすべて削除したいというのが、生徒さんの要望です。

こんなときにも、VBAが力を発揮しますよ。



それでは、始めましょうか。

例として、下のようなファイルを想定します。
分かりやすく、大きなオートシェイプになっていますよ。
ついでに、クリップアートも入れときました。





ALT + F11キーでVisual Basic Editorを起動します。

「挿入」メニューの「標準モジュール」をクリックします。

以下のように、コードを記述してください。

Sub DeleteShapes()
    Dim s As Shape
    
    For Each s In ActiveSheet.Shapes
        s.Delete
    Next
End Sub

こんな感じになります。




for each ～ next 構文は、繰り返し構文です。
アクティブなワークシートの中のすべての図形を順番に取得します。

そして、それを逐一削除するのです。


それでは、実行してみましょう。

Excelに切り替えて、Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。

Altキーを押しながらF8キーを押しても同様です。


表示されたマクロダイアログボックスの実行ボタンをクリックしてください。




すると、見事にすべての図形が削除されますね。

目に見えないほど、小さくされてしまった図形も、これできれいさっぱり削除できます。

おためしあれ。







だい

セルを色々な色で一瞬にして塗りつぶす ColorIndexの活用(Excel2000以降）

さて、今日は、セルを色々な色で一瞬にして塗りつぶしてみましょう。

といっても、セルは、Excel2003以前は、256列　65536行　

Excel2007にいたっては、16384列　1048576行　もありますから、

今回は、A列だけを57行目まで塗りつぶしてみます。


なぜ57行なのかというと、ExcelVBAがあらかじめ、

56の色の見本（インデックス）を持っているからです。



それでは、やってみましょう。


エクセルを起動したら、ALT + F11キーでVisual Basic Editorを起動します。

「挿入」メニューの「標準モジュール」をクリックします。

以下のように、コードを記述してください。

Sub カラーインデックス()
    Dim i As Integer
    
    For i = 1 To 57
        Range("A" & i).Interior.ColorIndex = i - 1
    Next
End Sub

こんな感じになります。





コードは以上です。簡単でしょ。

ColorIndex ってのが、色に付けられた番号です。

1は、黒
2は、白
3は、赤
・・・と、決まっているのです。

全部で56ありますよ。


それでは、Excelに切り替えて、Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。

Altキーを押しながらF8キーを押しても同様です。


表示されたマクロダイアログボックスの実行ボタンをクリックしてください。





すると、A列のセルが順番に塗りつぶされます。





ついでだから、一番下までご覧頂きましょう。






どうも、同じ色が何度か登場しているような気がするのは、僕だけでしょうか？




だい

開いても、10秒後に自動的に終了するファイルを作る方法(Excel2000以降）

さて、今日は、エクセルファイルを開いたら、10秒後に自動的に閉じてしまうという、ある意味何の役にも立たないプログラムをご紹介しましょう。

まあ、お遊びだと割り切って、お付き合いください。


エクセルを起動したら、ALT + F11キーでVisual Basic Editorを起動します。

「挿入」メニューの「標準モジュール」をクリックします。

以下のように、コードを記述してください。

Sub msg()

    MsgBox "ごめん、終了します・・・"
    ThisWorkbook.Close True
    
End Sub

こんな感じですよ。





さらに、今回は、もう一つのプロシージャを、別のモジュールに記述します。

画面左のプロジェクトエクスプローラの中の、「This Workbook」をダブルクリックして、
コード画面を表示してください。

そこに、以下のようにコードを記述します。

Private Sub Workbook_Open()



    Application.OnTime Now + TimeValue("00:00:10"), "msg"

    

End Sub

こんな感じですよ。





できたら、エクセルに切り替えて、任意のファイル名で、任意の場所に保存してください。

ファイルを閉じます。


さあ、このファイルを開いてみます。果たしてどうなるのやら・・・


開いたときに、以下の画面が表示されたら、
「マクロを有効にする」ボタンを押してください。




ファイルを開いたところです。

雰囲気を出すために、テキストボックスを配置しておきました。
プログラムとは何の関係もありません。。。






すると、10秒後に・・・








上のように、メッセージボックスが表示されました。

おそるおそる、OKをクリックすると・・・



ファイルは、自動的に閉じてしまいましたとさ。



※補足：このファイルを編集したいときは、開くときに表示されるダイアログボックスで、「マクロを無効にする」ボタンを押してください。



だい

任意の日付から、カレンダーを自動作成する(Excel VBA)

さあ、今日は、エクセルでカレンダーを作ってみましょう。

折角ですから、好きな日付を指定すると、その月のカレンダーを自動で作成するようにします。

関数を駆使しても出来ると思いますが、今回は、VBAを使用してみます。
そんなに長いコードではありませんから、ご心配なく。


これが、完成画面です。





J列1行目に　任意の日付を入力します。
そして、マクロを実行すると、カレンダーが作成されます。


なお、1行目の曜日は、最初に入力しておいてください。
罫線も、お好みで設定してください。


それでは、ALT + F11 で、Visual Basic Editorを起動します。

「挿入」メニューの「標準モジュール」をクリックします。

以下のように、コードを記述してください。

Sub MakeCalendar(hi As Date)
    Dim i As Integer
    Dim g  As Integer
    Dim r As Integer
    Dim lastDay As Integer
    
    g = 2
    r = Weekday(DateSerial(Year(hi), Month(hi), 1), vbSunday)
    lastDay = Day(DateSerial(Year(hi), Month(hi) + 1, 1) - 1)
    
    For i = 1 To lastDay
        Cells(g, r).Value = i
        If r = 7 Then
            r = 1
            g = g + 1
        Else
            r = r + 1
        End If
    Next
End Sub

Sub test()
    Range("A2:G7").Value = ""
    MakeCalendar Range("J1").Value
End Sub

こんな感じですね。






MakeCalendar　が、サブルーチンで、実際の処理部分です。

指定された日付の月の1日が、何曜日かを調べて、
その曜日から順に、1から始まる連番を入力するという仕組みです。
月末が何日かも、きちんと設定されます。

マクロで実行するのは、　test　ですよ。

日付のセル範囲をクリアしてから、サブルーチンを実行しています。



それでは、実行してみましょう。

エクセルに切り替えてください。

J列1行目に　任意の日付を入力してください。
ちなみに、今回は、7/4と入力してみました。

「ツール」→「マクロ」→「マクロ」とクリックします。

ダイアログボックスが表示されたら、「実行」ボタンをクリックします。





すると、7月のカレンダーが作成されました。




日付を変えて、何度でも、作成してください。


ボタンにマクロを登録しておけば、もっと便利になりますよ。(^^)



だい