マクロの便利技


ExcelVBAを使っていると、いろいろな裏技に出会います。ここでは、それらを忘れないようにまとめてみました。
Win坊が使って、忘れないようにメモしたものです。マクロは奥が深く、日々勉強ですね(日々忘れるので・・)。

警告を表示させないようにする

例えば、シートの削除のコマンド ActiveWindow.SelectedSheets.Delete を、

Application.DisplayAlerts = False
  この間に入れれば、警告は出さずに実行されます。
Application.DisplayAlerts = True
 

オブジェクトのボタンを隠すには、

 ActiveSheet.Shapes("Button 13").Visible = False
ボタンの番号は、選択して座標ウインドウを見ます。 
 

ThisWorkBook に、Private Sub Workbook_Open()を作ります。
Bookを開いたときに、Sheet1を開きたいときは

Private Sub Workbook_Open()
   Sheet1.Activate
End Sub
です。

または、
Auto_Open()という名前のサブルーチンを記述します。例えば、Sheet1を開かせたい場合は、
Sub Auto_Open()
 Sheet1.Activate
End Sub
とします。

ファイル選択のダイアログを表示する

With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = パス & "*.jpg" '← ワイルドカード
If .Show() = 0 Then Exit Sub
MsgBox .SelectedItems(1)
Cells(1, 2) = .SelectedItems(1)   'ファイル名を、セルに出力します。
End With

便利な検索ルーチン

検索関連のワークシート関数は、Application.WorksheetFunction で使えないものが多いので、VBAにはVBAの専用の検索関数を使います。以下のパターンを覚えておくと、シート内のデータを検索してくれます。

Dim YLine As Long
Dim XLine As Integer
Dim Obj As Object
smoji = InputBox("検索文字を入力してください")
Set Obj = Sheet1.Cells.Find(smoji)
If Obj Is Nothing Then
MsgBox smoji + "は見つかりませんでした。"
Else
YLine = Sheet1.Cells.Find(smoji).Row
XLine = Sheet1.Cells.Find(smoji).Column
MsgBox smoji + "は、" + CStr(YLine) + "行目の" _
+ CStr(XLine) + "列目にあります"
End If
この例は、InputBox と MsgBox を使っていますが、要するに smojiという文字列データを、sheet1(シート見出しの名前ではありません)の中で探して、見つかったらそのセルの行(YLine)と列(XLine)の番号を返してくれるものです。

列を指定して検索する場合は、

Set Obj = Sheet1.Columns("C").Find(What:=smoji)    *What:=は、複数のオプションを入れるときに使います。
YLine = Obj.Row  これで発見された行が得られます。

検索を続行して、次の検索値を得るには
 Set Obj = Sheet2.Columns("C").FindNext(Obj)

 これを、Do Loopで繰り返すと、最下行まで行った後は最初に戻ります。
 

matchなどの検索系の関数を使うと、結果が#N/Aなどになる場合があります。このようなセルの参照を含むマクロを組むときに、エラー値は特別な値になるので、if分などで除外しておかないとマクロが止まってしまいます。このような場合は、IsErrorの値を条件にします。
例えば、Cells(I,J) の値を調べる場合は、以下のような条件文を書きます。

 If IsError(Cells(i, j).Value) Then
  'エラーの時
 Else
  'エラーでない時
 End If

エラーの種類で分岐したい場合は、

 If IsError(ActiveCell.Value) Then
errval = ActiveCell.Value  として、errval の値を取得します。この値は、CVErr(**) の引数を以下のように指定した値になります。
これが、#DIV/0! エラー のときは CVErr(xlErrDiv0)  #N/A エラー のときは CVErr(xlErrDiv0)
#NAME? エラーは、CVErr(xlErrName)  #NULL! エラーは、CVErr(xlErrNull)  #NUM! エラーは、CVErr(xlErrNum)
#REF! エラーは、CVErr(xlErrRef)  #VALUE! エラーは、CVErr(xlErrValue)  となります。

  マクロを実行するのには、ボタンをを配置して、これにマクロを登録するか、ショートカットキィを登録してキィボードから指示するか、またはツールメニューのマクロから指定します。マクロの存在を意識せずに、セルの値が入力されたら自動的に実行させたい、という場合には、モジュールシート以外の場所に、特定のマクロを書き込みます。 マクロは、Moduleシート以外にもかけます。

普通に、モジュールシートに、keisanというマクロを作りました。これは、A1(cells(1,1))の値を読み取って、これを2倍して1をたしたものをB1(cells(1,2))に表示するというものです。これを、A1に入力があったら即座に実行させようと思います。

そこで、Module1でなく、sheet1をWクリックして、ここにコードを書き込みます。ちょっと長いですが、名前は
Private Sub Worksheet_Change(ByVal Target As Range) とします。これと、End Sub の間に、
 If Target.Column = 1 And Target.Row = 1 Then        ' 変化を検知するセルの列数(Column)と行数(Row)を指定します
    keisan
    Range("C1").Select
End If
このIf文の組は、複数書き込めるので、セルの値によって実行するマクロを選ぶこともできます。

最後の、Range().Select は、単に実行が終わったことを示すために、カーソルを移動させるものです。

このようなPrivate Subは、Worksheet_Changeの他にもあります。
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  セルのWクリックを検知します 
Worksheet_SelectionChange(ByVal Target As Range)  セルの選択を検知します(入力が無くていい)

住所録作成に便利!
郵便番号辞書を使って、郵便番号を変換して住所を入力すると、これを郵便番号と住所の2列に入力するものです。 住所に変換してしまうと、郵便番号は読みとして残るので、これを元の列に入れ、変換後の住所を別の列に移動します。

例では、sheet1のA列が郵便番号、B列が住所11データで、ここに郵便番号変換したものが入ります。変換・確定すると、A列に住所が入りますが、これをB列に移動させ、A列には入れた郵便番号を半角文字で入力されます。これを、A列の値が変化したときにマクロを自動実行させています。

前項のように、これを使うシートのモジュールに作成します。

郵便番号を入れる列番号をXbで、住所1の列をxjの値で決めています。これは、自分の住所録に合わせて変更してください。また、辞書変換で出る住所に県名があって長くなるので、Replaceで消しています。ここも、不要なら変更・削除してください。

コードを打つのが面倒なら、以下からサンプルのエクセルファイルをダウンロードしてください。ダウンロードはここ。(ファイルは、xls形式ですが2007以降でも動きます。)
IMEの郵便番号辞書を有効にして、マクロを有効にして開いてください。または、以下のコードをコピーして、ワークシートのモジュールシートに貼り付けます。

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim xb, xj, yb As Single
 Dim buf, ybn As String
 xb = 1         '郵便番号列
 xj = 2         '住所1の列
 yb = Target.Row
If Target.Column = xb And Cells(Target.Row, xj) = "" Then
 buf = Cells(yb, xb)
 ybn = Application.WorksheetFunction.Phonetic(Cells(yb, xb))
 If Mid(ybn, 4, 1) = "−" Then
   ybn = StrConv(ybn, vbNarrow)
   ju1 = Cells(yb, xb)
   ju1 = Replace(ju1, "千葉県", "")     '省略県名
   ju1 = Replace(ju1, "東京都", "")
   Cells(yb, xj) = ju1
   Cells(yb, xb) = ybn
  End If
End If
End Sub
 

特定のセルを右クリックしたときに実行するマクロを作ります。この例は、B列のセルを右クリックしたときにメッセージが出て、そうでないときは普通の右クリックメニューが出ます。
下に、裏技の追加があります。右クリックメニューに追加するものです。

この場合、Sheet1だけに適用するので、プロジェクトウインドウのSheet1をWクリックしてワークシートのModuleを開きます。

 *このワークシートモジュールを使う上での注意は、ここのマクロは、このシートがアクティブになっていることが前提であることです。
Cells(*、*)は、当然ですが
マクロの中で、アクティブシートを切り替えても、ここに書かれたCell(*、*)は、このワークシートを意味します。


右の種類を開いて、BeforeRightClickを選択します。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range,Cansel As Boolean) というサブが作られるので、その中に書き込んで行きます。


小さいので、図を大きくしました。

ここでポイントは、Cancel = True です。これは、対象のセルだけ右クリックの通常メニューを表示させない、というものです。

これは便利! 右クリックメニューに追加してしまう

セルを右クリックして時のメニューに追加するものですが、これはエクセル本体に追加されるので、他のファイルを開いても出てしまうので、ファイル限定にするため終了時に削除しましょう。

★追加するマクロをオートオープンで設定する

 Sub Auto_Open()   'Sub AddMenu()
    Dim Newb
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "追加メニュー*"
        .OnAction = "実行マクロ名"
        .BeginGroup = False
    End With
 End Sub

メニューを削除するマクロを、オートクローズに設定する

 Sub Auto_Close()    'dellmenu()
    Application.CommandBars("Cell").Controls("追加メニュー*").Delete
 End Sub

 追加メニュー*は、追加したいメニュー表示の記述で、同じものを追加・削除しないといけません。
 マクロを登録した後の、最初の終了でエラーが出ます(追加されていないので)。

選択されているセルの座標は
Target.Row で列が、Target.Column で行が得られます。

範囲で、複数選択した場合は、上記でその左上のスタートのセルの情報が得られますが Selection.Rows Selection.Culmns で、列の数と行の数が得られます。(複数形に注意)範囲の右下の座標は、Target.Row + Selection.Rows - 1 のようになります。

一つのセルしか選択していなければ、Rows Culumns の値は1になります。

次の行を選択する
ActiveCell.Offset(1, 0).Select ですが、フィルターが掛かっているシートで、次の行を選択するには
Do
 ActiveCell.Offset(1, 0).Select
 Loop While Rows(ActiveCell.Row).Hidden
とすることで、非表示でない行をとばして、選択できます。

シートのデータの最終行を得る
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row

特定のセルの値を調べて、条件に合わないときに印刷ができないようにします。この場合は、ThisWorkbookを開いて
Private Sub Workbook_BeforePrint(Cancel As Boolean) と言う名前のマクロを書きます。

上の例は、セル(1,15)の値がOKでないときは、MsgBoxで警告を表示し、Cancel=True で、印刷をキャンセルします。

ヘッダー・フッターを書き込む

  ActiveSheet.PageSetup.CenterHeader = Range("A1").Value
  ActiveSheet.PageSetup.RightFooter = Format(Date, "ggge年m月d日")

これは、右のフッターにセルA1の値を入れ、年号書式を設定するものです。
同様に、 LeftHeader : 左側のヘッダー CenterHeader : 中央のヘッダー RightHeader : 右側のヘッダー LeftFooter : 左側のフッター CenterFooter : 中央のフッター RightFooter : 右側のフッター になります。

ファイルがあるかどうか調べる

Dir(ファイルのフルパス名) この値が、ヌルの時は、ファイルがなく、ファイル名の時は、存在します。

フォルダがあるかどうか調べる
chk = Dir("c:\test\") このときchkには、Cドライブのtestというフォルダの中のファイル名が入ります。フォルダそのものがなければ、ヌルが入りますが、フォルダはあって、中身がない場合も同じなので、注意が必要です。


Kill ファイル名(フルパス)  ファイルを削除します。
いずれも、パスを省略すると、bookを開いた場所(アクティブパス)になります。ファイル名は文字列です。


エクセルを終了して、ワードを開く

ThisWorkbook.Save エクセルを、上書き保存します。
Call Shell("WINWORD C:\**.doc", vbNormalFocus)  または Shell "cmd /c C:\**doc", vbHide
Application.Quit  開いた後で終了します。


拡張子.txtのファイルは、メモ帳でも編集でき、文字データを保存しておくには、最も手軽なファイルです。エクセルで、このtxtファイルに書き出したり、ここから読み込んだりできると、より拡張した使い方ができますね。

読み込み:
Dim datal As String     ’読み込んだ行データを入れる変数です。
txtname = "ファイル名"     ’ファイル名は、パスも付けて指定します。( C:\****\****\***.txt )
Open txtname For Input As #1   ’ファイルをOPENする命令です。
For i = 1 To 100
Line Input #1, datal   Input #1でも良いのですが、行内に,(カンマ)があると2行分になるのを防ぎたいときは、Line Inputを使います。
 Cells(i,1) = datal
If datal = "// -->" Then Cells(i, 1) = "": Exit For   ’For Next を使ったので、txtファイルの終わりの文字を指定しました。
Next i
Close #1      Openに対して、必ずClose で 開いたファイルを閉じます。

書き出し:
txtname = "ファイル名"  ’読み込みの場合と同じです。
Open txtname For Output As #1   ’今度は、 Output として開きます。
For i = 1 To 100
Print #1, Cells(i,1)     ’Print #1 で1行分のデータを書き出します。
Next i
Close #1          ’開いたら閉めるのが決まりです。

書出し2:追記していく場合は

Open txtname For Append As #1 で開きます。

QRコード画像作成の例

エクセルからexeファイルを実行させたい場合、バッチファイルに記述して、バットファイルを実行させる方法と、エクセルから直接コマンドを実行する場合と、2通りの方法があります。

例えば、mkqrimg.exe というQRコード画像を作成するファイルを、エクセルから利用する場合で説明します。

1.バッチファイル:qr.batを作って、ここにexeファイルの起動コマンドを書いておきます。
 C:\QRcode\mkqrimg.exe /O"C:\QRcode\Test.bmp" /T"エンコード%0D%0Aテスト" /S3
 この1行が、バッチファイルの中身です。このように、/以降のオプションが並び、その文字列にスペースや不可視文字が入る場合、記述が面倒になるので、batファイルで確認しておいた方が楽です。
Sub QRbat()
 Dim ShellObject As Object
 Dim MsgBoxRet As String
 Set ShellObject = CreateObject("WScript.Shell")
 ShellObject.Run "C:\QRcode\qr.bat", 0, True
 ActiveSheet.Pictures.Delete    '予め画像を消します。
 ActiveSheet.Pictures.Insert("C:\QRcode\Test.bmp")
'これは、できたQRコード画像をシートに貼り付けるためのものです。
End Sub

2.直接コマンドを実行する場合

Sub qrcode() '  mkqrimg.exeをC:に
Set WSH = CreateObject("Wscript.Shell")  '/T以降のコードは、シートから取得しています。
Cmd = "C:\mkqrimg.exe" + " /O" + Chr(34) + "C:\Test2.bmp" + Chr(34) + " /T" + Chr(34) + Cells(1, 8) + "%0D%0A" + Cells(2, 8) + "%0D%0A" + Cells(3, 8) + Chr(34) + " /S3"
Set wExec = WSH.Exec("%ComSpec% /c" & Cmd)
Do While wExec.Status = 0
DoEvents
Loop
Result = wExec.StdOut.ReadAll
Set wExec = Nothing
Set WSH = Nothing
ActiveSheet.Pictures.Delete  '予め画像を消します。
ActiveSheet.Pictures.Insert("C:\Test2.bmp")
Cells(1, 1).Select
End Sub

この場合、ダブルクォーテーションそのものをコマンドに出力するために、Cmdの文字列を作るのに工夫が必要です。
exeファイルの場所などに、デスクトップやマイドキュメントなどスペースの入るアドレスを指定するのが難しいので、Cドライブにおいています。

この、mkqrimg.exe は、Psytecさんのページで公開されています。

エクセルから、メールの送受信・Webサーバーからダウンロード・アップロード するには

 普通ではできませんが、フリーで提供されているBASP21(ビーエーエスピー21)というコンポーネントをインストールすることで、VBAに機能を追加でき、その機能を使ってこれらが可能になります。実際の使い方は、(officeTANAKAさんのページ)ここにあるのでリンクをおいておきます。 若干制限はありますが、大変便利なもので、Win坊も長く使わせてもらっていました。
しかし、これはVista以降で使うことはできませんでした。そこで、新たに探したところ、
 http://www.happy2-island.com/access/gogo03/capter90302.shtml に、API関数を使う方方が紹介されていました。
InternetOpenとInternetConnectでFTPサーバへ接続した後、FtpPutFileを使うものです。
この関数を使う準備(定義)が面倒ですが、関数を定義した後は、下のようなマクロを作成して、簡単につかえます。この他に必要な関数も含めて、Mojule2.basにまとめたので、ダウンロードして解凍した後、VBAエディターのメニューからインポートして下さい。

Sub ftp1()
Dim lngRC As Long
Dim txtname As String 'FTPしたいファイルの名前(フルパス)
Dim sadd As String 'サーバーのアドレス
Dim snam As String 'サーバーのユーザー名
Dim spasw As String 'サーバーのパスワード
Dim sdir As String '転送先のサーバーパス
Dim sfnam As String '転送先でのファイル名

txtname = ActiveWorkbook.Path + "\**test.txt" '以下の中身を設定します
sadd = "***.ne.jp"
snam = "user*"
spasw = "password*"
sdir = "/***/***/****/"
sfnam = "**test.txt"

lngRC = fcInternetOpen
If lngRC = 0 Then

lngRC = fcFTPConnect(sadd, snam, spasw)

If lngRC = 0 Then
Call fcFTPPutFile(txtname, sdir + sfnam, FTP_TRANSFER_TYPE_ASCII)
End If

End If

Call fcFTPDisConnect
Call fcInternetClose

End Sub
 

 

 

エクセル2003で、OCR(画像から文字データを読み込む)ができます。実は、2007以降では、この機能は省略されてしまいました。 互換性のため、2007でもMicrosoftのアドインをインストールすればできるようですが、2010ではそれもありません。

これを使うには、Office2003を完全インストールしないといけません。CDを入れてセットアップを実行し、この機能が入っているか確認し、無ければ追加インストールします。

Office共通ツールの中の、MicrosoftOfficeDocumentImagingを開き、「スキャン、OCRおよびIndexServiceフィルタ」の項目を調べます。黄色の1になっている場合は、コンピューターからすべて実行を選び、更新をクリックして追加インストールします。

更に、VBエディタを開き、ツール・参照設定でMicrosoft Office Document Imaging 11.0 Type Library にチェックを入れて、参照を設定します。

ここまで準備ができたら、以下のようなsubを作成します。

サンプルファイルがあるので、ダウンロードして参考にしてください。*下は画像なので、コピーできません。

これを起動すると、画像ファイルを聞いてくるので、jpgなどを指定します。画像中の文字が読めない場合にエラーが起きるので、エラー処理を追加しています。

このような新聞記事(朝日新聞 2013/1/27版)をスキャンしてみました。

これは縦書きで、しかも写真やタイトル画像も含まれています。

実際は、400dpiでスキャンしたjpg画像で500KBくらいの容量がありました。余分なものをトリミングしていますが、回転修正や背景の色修正なども加えていません。

カラーでスキャンしたので、新聞の紙の色も出ています。下が、マクロで読み込んだ文字です。A1に書き込みました。B1は、選択したファイル名です。


かなり高い識字率です。こういう機能が、excelのマクロで使えるなんて、すばらしいですね。何故、2007以降で廃止されたのか、残念です。というより、Office2003は、もう改良する必要の無い、完璧なものです。もう入手できないので、持っている人は大事に使ってください。ちなみに、使ったスキャナーは、このようなハンディスキャナーです。


 

 

 

エクセルから、faxを送るマクロです。Microsoftfaxがインストールされていて、faxモデムがあり、電話回線に繋がっていることが条件です。
faxプリンターで印刷する、というマクロを使うには、プリンターをFaxにして、これで印刷というマクロにすれば良いのですが、宛先などを手動で入力することになります。それではマクロを使う便利さが減るので、ここでは直接呼び出す方法を紹介します。

1.faxcom Type Library を使う場合:
参照設定で、faxcom Type Libraryを有効にしておきます。OSのバージョンによって異なりますが、これが無い場合はプリンター一覧にfaxが無い場合です。microsoftFaxをインストールし、モデムを設定してください。
簡単な、サンプルコードは、下記の通りです。

Sub fax1()
Dim faxServer As New FAXCOMLib.faxServer
Dim FaxDoc As New FAXCOMLib.FaxDoc
Dim FaxNumber As String
faxServer.Connect ""
Set FaxDoc = faxServer.CreateDocument("ファイル指定")
FaxDoc.RecipientName = "受信者名"
FaxDoc.SenderTitle = "件名です"
FaxDoc.DisplayName = "Fax送信テスト"
FaxNumber = "03*********"   '-は取り除いておく
FaxDoc.FaxNumber = FaxNumber
FaxDoc.Send
faxServer.Disconnect
End Sub

ファイルの指定は、ワード・エクセル・テキストなど使えますが、一番良いのはpdfです。フルパスで指定してください。

2.Microsoft Fax Service Extended Com Type Library を使う場合
同じく、参照設定で、これを有効にしておきます。両方有効にする必要はありません。簡単な、サンプルコードは以下の通りです。

Dim FaxDoc
Set FaxDoc = CreateObject("FaxComEx.FaxDocument")
FaxDoc.Recipients.Add "*********" '電話番号にハイホンは入れない
FaxDoc.Body = "C:\tmp\TEST.pdf"  ' などフルパスでファイルを指定
FaxDoc.submit ""  ' 件名です
 

どちらを使っても、microsoftFaxが起動します。動きは、同じです。アドレスの入力画面は出ませんが、送信後に確認のダイアログが残ります。faxサーバーに履歴も残ります。 マクロのあるブックのシートをfaxしたい場合、ファイル名が自身のエクセルになるので、うまく行かないようです。その場合は、アクティブシートを開いて、faxプリンターを指定して印刷する、というマクロを作ります。ページ数や用紙の指定など面倒なので、いったんpdfを作って、別ファイルをfax送信した方が良いです。