2017年10月31日

【Access】VBAからコントロールを作成する


CreateControlメソッドを使うとVBAからコントロールを作成することが出来ます。

構文

CreateControl(フォーム名, コントロールの種類, [Section], [Parent], [ColumnName], [左位置], [上位置], [幅], [高さ])

[]は省略可能。[左位置], [上位置], [幅], [高さ]はtwip単位で指定。


たとえば、「フォーム1」にラベルを作成するには次のように記述します。
Public Sub CreateLabelControl()

    Dim label As Control
    
    DoCmd.OpenForm "フォーム1", acDesign
    
    Set label = CreateControl("フォーム1", acLabel, , , , 1000, 1000, 3000, 500)
    
    label.Name = "labelMessage"
    label.Caption = "こんにちは"
    label.FontSize = 20
    label.BorderStyle = 1
    label.BorderColor = vbBlack
    label.ForeColor = vbBlack
    
    DoCmd.Close acForm, "フォーム1", acSaveYes
    
    DoCmd.OpenForm "フォーム1", acNormal
    
End Sub

2017年10月30日

【Access】VBAで指定したフォームを選択する


VBAで指定したフォームを選択するには、DoCmdオブジェクトのSelectObjectメソッドを使います。

たとえば、「フォーム2」という名前のフォームを選択するには次のように記述します。
Public Sub SelectForm()

    DoCmd.SelectObject acForm, "フォーム2"

End Sub

2017年10月29日

【Linux】Linux Mint にSQL Serverをインストールしてみた




先日、SQL ServerのLinux版が正式にリリースされたということで、試しにLinux Mintにインストールしてみました。



まずは下記のサイトに行きます。

https://www.microsoft.com/ja-jp/sql-server/sql-server-downloads


サイトに行ったら、Linuxのメニューから「Ubuntu Linux 16.04 にインストールする」をクリックします。
Linux Mint 18 は、Ubuntu Linux 16.04 がベースになっていますので、これをクリックします。

クリックするとインストール手順が書かれたページが開きますので、この手順にそってインストールを行ってみます。



まず、パブリックリポジトリ鍵キーをインポートします。
$ curl https://packages.microsoft.com/keys/microsoft.asc | sudo apt-key add -

次に、Microsoft SQL Server Ubuntu リポジトリを登録します。
$ sudo add-apt-repository "$(curl https://packages.microsoft.com/config/ubuntu/16.04/mssql-server-2017.list)"

この2つに関してはよく分かりませんが、おそらくGitか何かのリポジトリにアクセスするためのものと思われます。とりあえず書いてあるとおりに実行します。


ここまで出来たら、SQL Serverをインストールします。

つぎのようにコマンドを打ちます。
$ sudo apt-get update
$ sudo apt-get install -y mssql-server


パッケージのインストールが完了したらエディションを選択します。
$ sudo /opt/mssql/bin/mssql-conf setup
SQL Server のエディションを選択します:
  1) Evaluation (無料、製品使用権なし、期限 180 日間)
  2) Developer (無料、製品使用権なし)
  3) Express (無料)
  4) Web (有料)
  5) Standard (有料)
  6) Enterprise (有料)
  7) Enterprise Core (有料)
  8) 小売販売チャネルを介してライセンスを購入し、入力するプロダクト キーを持っています。

エディションの詳細については、以下を参照してください
https://go.microsoft.com/fwlink/?LinkId=852748&clcid=0x411

このソフトウェアの有料エディションを使用するには、個別のライセンスを以下から取得する必要があります
Microsoft ボリューム ライセンス プログラム。
有料エディションを選択することは、
このソフトウェアをインストールおよび実行するための適切な数のライセンスがあることを確認していることになります。

エディションを入力してください(1-8): 2
Evaluation、Developer、Expressが無料で使えます。
今回、Developer版を選びました。


次にライセンス条項の同意を求めてきます。
この製品のライセンス条項は
/usr/share/doc/mssql-server で参照できるほか、次の場所からダウンロードすることもできます:
https://go.microsoft.com/fwlink/?LinkId=855862&clcid=0x411

プライバシーに関する声明は、次の場所で確認できます:
https://go.microsoft.com/fwlink/?LinkId=853010&clcid=0x411

ライセンス条項に同意しますか? [Yes/No]:Y
Yで同意します。


次に言語の設定です。
SQL Server の言語の選択:
(1) English
(2) Deutsch
(3) Español
(4) Français
(5) Italiano
(6) 日本語
(7) 한국어
(8) Português
(9) Русский
(10) 中文 – 简体
(11) 中文 (繁体)
オプション 1-11 を入力: 6
日本語を選択します。


次にsaのパスワードを設定します。
SQL Server システム管理者パスワードを入力してください: 
SQL Server システム管理者パスワードを確認入力してください: 
SQL Server を構成しています...

Created symlink from /etc/systemd/system/multi-user.target.wants/mssql-server.service to /lib/systemd/system/mssql-server.service.
セットアップは正常に完了しました。SQL Server を起動しています。


最後にサービスが実行されていることを確認し、実行されていればとりあえずインストールは完了です。
$ systemctl status mssql-server


次に、コマンドラインツールをインストールしていきます。
これはsqlcmdとbcpを使えるようにするためのものです。

これも手順通りに実行します。

パブリックリポジトリ鍵キーのインポート。
$ curl https://packages.microsoft.com/keys/microsoft.asc | sudo apt-key add -

Microsoft Ubuntu リポジトリを登録。
$ sudo add-apt-repository "$(curl https://packages.microsoft.com/config/ubuntu/16.04/prod.list)"

ソースリストを更新し、unixODBC 開発者のパッケージでインストール コマンドを実行。
$ sudo apt-get update
$ sudo apt-get install -y mssql-tools unixodbc-dev

パス環境変数
$ echo 'export PATH="$PATH:/opt/mssql-tools/bin"' >> ~/.bash_profile
$ echo 'export PATH="$PATH:/opt/mssql-tools/bin"' >> ~/.bashrc
$ source ~/.bashrc



では、実際にデータベースを作成して、テーブルを作成し、データを挿入してみたいと思います。


まずは、データベースエンジンに接続。
$ sqlcmd -S localhost -U SA -P 'パスワード'


次に、データベースの作成
1> CREATE DATABASE MYDB
2> GO
1> SELECT Name FROM sys.Databases
2> GO
Name                                                                                                                            
--------------------------------------------------------------------------------------------------------------------------------
master                                                                                                                          
tempdb                                                                                                                          
model                                                                                                                           
msdb                                                                                                                            
TestDB                                                                                                                          
MYDB                                                                                                                            

(6 rows affected)


そして、データベースMYDBを選択し、
1> USE MYDB
2> GO
データベース コンテキストが 'MYDB' に変更されました。


テーブルの作成します。
1> CREATE TABLE T_Mascots ([ID] [int] NOT NULL, [Name] NVARCHAR(50) NULL, [Type] NVARCHAR(50) NULL)
2> GO
1> SELECT Name FROM sys.tables
2> GO
name                                                                                                                            
--------------------------------------------------------------------------------------------------------------------------------
T_Mascots                                                                                                                       

(1 rows affected)


最後にデータを挿入してみます。
1> INSERT INTO T_Mascots VALUES (1, 'あゆコロちゃん', 'ぶた')
2> GO

(1 rows affected)
1> INSERT INTO T_Mascots VALUES (2, 'ぐんまちゃん', 'ポニー')
2> GO

(1 rows affected)
1> INSERT INTO T_Mascots VALUES (3, 'ひこにゃん', '猫')
2> GO

(1 rows affected)


SELECT文でデータを参照してみます。
1> SELECT ID, Name, Type FROM T_Mascots
2> GO
ID          Name                                               Type                                              
----------- -------------------------------------------------- --------------------------------------------------
          1 あゆコロちゃん                                            ぶた                                                
          2 ぐんまちゃん                                             ポニー                                               
          3 ひこにゃん                                              猫                                                 

(3 rows affected)

ちゃんと挿入したデータが表示できました。

まだここまでしか使っていませんが、Windows版とまったく同じ操作でデータベースにアクセス出来るのにはちょっと感動です。まあ、マイクロソフトはそのように作ったと言ってるので、当たり前と言えば当たり前ですが、けっこうすごいことだと思います。

いままで、SQL Serverを使うにはWindowsマシンが必ず必要でしたが、これからはLinuxマシンでもいいということになります。これは別の言い方をすれば、SQL ServerのためにWindowsマシンを用意しなくてもいいということになります。高価なWindows Server OS を用意できないような中小零細企業などにはかなりメリットがあると思えますね。


<関連記事>
Windows10マシンにデュアルブートでインストールしたLinux Mintを削除する方法
Windows10マシンにLinux Mintをインストールしてデュアルブート化してみた。
【Linux】Linux Mint にPowerShellをインストールしてみた。
Linux Mint にSophos Anti-Virus for Linux(Free Edition)を入れてみた
【Linux】viの使い方はとりあえずこれだけ知っていればなんとかなる
【Linux】Linux MintでGRUBのメニューの順番を変える


2017年10月28日

【PowerShell】Bloggerのフィード情報を読み込んで最新記事5件分を表示するスクリプト


Bloggerのフィード情報を読み込んで最新記事5件分を表示するスクリプトを作ってみました。

$atom = Invoke-WebRequest https://hosopro.blogspot.com/feeds/posts/default
$xml = [xml]$atom.Content
$ent = $xml.GetElementsByTagName("entry")

for ($i = 0; $i -lt 5; $i++){

    #タイトル
    $ent[$i].Item("title")."#text"

    #投稿日時
    $date = [DateTime]$ent[$i].Item("published")."#text"
    $date.ToString("yyyy/MM/dd HH:mm")
    
    #サマリー
    $ent[$i].Item("summary")."#text".Replace("`n",'').Substring(0, 50).trim() + "..."

    Write-Host
}
フィードの取得にはInvoke-WebRequestを使っています。
サマリーは50文字分表示するようにしてみました。


実行結果
PS C:\work\PowerShell> .\Get-BloggerFeed.ps1
【Access】現在開いている全てのフォームを参照する
2017/10/27 22:13
現在開いている全てのフォームを参照するには、Formsコレクションを使った方法とAllFormsコレ...

【Access】データベース内の全てのフォームを参照する
2017/10/26 21:25
データベース内の全てのフォームを参照するには、AllFormsコレクションを使います。例たとえばこの...

【Access】フォームの背景色を変更する
2017/10/25 21:38
フォームの背景色は、各セクションのBackColorプロパティに値を設定することで変更できます。例た...

【Access】帳票フォームでRequeryを行っても画面がチラつかないようにする
2017/10/24 21:49
前回、「帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする」方法を書きま...

【Access】帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする
2017/10/23 21:00
帳票フォームでデータの更新などを行ってフォームのRequeryを実行するとレコードの表示が変わってし...






2017年10月27日

【Access】現在開いている全てのフォームを参照する


現在開いている全てのフォームを参照するには、Formsコレクションを使った方法とAllFormsコレクションを使った方法があります。

たとえばこのようなデータベース(accdbファイル)があるとします。



開いている全てのフォーム名を取得するにはそれぞれ次のように記述します。

Formsコレクション

Public Sub GetOpenFormsInfo()

    Dim frm As Form
    Dim msg As String
    
    For Each frm In Forms
    
        msg = msg & frm.Name & vbCrLf
        
    Next
    
    MsgBox msg
    
End Sub
Formsコレクションは、現在開いているフォームのコレクションになります。


AllFormsコレクション

Public Sub GetOpenFormsInfo()

    Dim frm As AccessObject
    Dim msg As String
    
    For Each frm In CurrentProject.AllForms
    
        If frm.IsLoaded Then
            msg = msg & frm.Name & vbCrLf
        End If
        
    Next
    
    MsgBox msg
    
End Sub
IsLoadedは、AccessObjectが現在ロードされているかを示します。すなわちIsLoaded=Trueならフォームが開いているということになります。

2017年10月26日

【Access】データベース内の全てのフォームを参照する


データベース内の全てのフォームを参照するには、AllFormsコレクションを使います。

たとえばこのようなデータベース(accdbファイル)があるとします。



このデータベース内の全てのフォームのフォーム名を取得するには次のように記述します。
Public Sub GetAllFormsInfo()

    Dim frm As AccessObject
    Dim msg As String
    
    For Each frm In CurrentProject.AllForms
    
        msg = msg & frm.Name & vbCrLf
        
    Next
    
    MsgBox msg
    
End Sub

2017年10月25日

【Access】フォームの背景色を変更する


フォームの背景色は、各セクションのBackColorプロパティに値を設定することで変更できます。

たとえば、フォームヘッダー、詳細、フォームフッターの背景色を変更するには次のように記述します。
Private Sub Form_Load()

    Me.フォームヘッダー.BackColor = vbYellow
    
    Me.詳細.BackColor = vbCyan
    
    Me.フォームフッター.BackColor = vbGreen
    
End Sub

2017年10月24日

【Access】帳票フォームでRequeryを行っても画面がチラつかないようにする


前回、「帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする」方法を書きましたが、この方法だとレコード件数が多くなってくると画面のチラつきが気になってきます。

このような場合、フォームのPaintingプロパティを一時的にOFFにして描画を止めることによって画面のチラつきを抑えることが出来ます。

Private Sub buttonRequery_Click()

    Dim headerHeight As Long
    Dim curTop As Long
    Dim curRecNum As Long
    Dim topRecNum As Long
    
    Me.ID.SetFocus
    
    curRecNum = Me.CurrentRecord
    
    headerHeight = Int(Me.Section("フォームヘッダー").Height / Me.Section("詳細").Height)
    
    curTop = Me.CurrentSectionTop
    
    topRecNum = curRecNum - (Int(curTop / Me.Section("詳細").Height) - headerHeight)
    
    'フォームの描画をOFF
    Me.Painting = False
    
    '再表示
    Me.Requery

    '表示の復元
    DoCmd.GoToRecord acActiveDataObject, , acLast
    DoCmd.GoToRecord acActiveDataObject, , acGoTo, topRecNum
    DoCmd.GoToRecord acActiveDataObject, , acGoTo, curRecNum
    
    'フォームの再描画をON
    Me.Painting = True
 
End Sub

Requeryの前に「Painting = False」で描画をOFFにして、レコードの表示位置を復元したあとに「Me.Painting = True」で再描画をONにしています。

少ないレコード数では、この処理を入れるのと入れないのであまり違いがみられませんが、レコード数が多くなってくると明らかに違いが出てきます。

2017年10月23日

【Access】帳票フォームでRequeryを行ってもレコードの表示位置が変わらないようにする


帳票フォームでデータの更新などを行ってフォームのRequeryを実行するとレコードの表示が変わってしまうことがあります。そうするとシステムとしては非常に使いにくいものになってしまいます。

Accessではレコードの表示位置を覚えているわけではないのでこれは仕方ないことなのですが、ちょっとしたテクニックでこの表示位置を維持することが出来ます。

たとえばこのような帳票フォームがあるとします。



このフォームの「再表示」ボタン(buttonRequery)をクリックしてもレコード位置が変わらないようにするためには、クリックイベントプロシージャに次のように記述します。

Private Sub buttonRequery_Click()

    Dim headerHeight As Long
    Dim curTop As Long
    Dim curRecNum As Long
    Dim topRecNum As Long
    
    'IDにフォーカスを移す
    Me.ID.SetFocus
    
    'カレントレコードを取得
    curRecNum = Me.CurrentRecord
    
    'フォームヘッダー行数を取得
    headerHeight = Int(Me.Section("フォームヘッダー").Height / Me.Section("詳細").Height)
    
    '現在のセクションの上端からフォームの上端までの距離(twip)を取得
    curTop = Me.CurrentSectionTop
    
    '現在先頭に表示されているレコード番号を取得
    topRecNum = curRecNum - (Int(curTop / Me.Section("詳細").Height) - headerHeight)
    
    '再表示
    Me.Requery

    '表示位置の復元
    DoCmd.GoToRecord acActiveDataObject, , acLast
    DoCmd.GoToRecord acActiveDataObject, , acGoTo, topRecNum
    DoCmd.GoToRecord acActiveDataObject, , acGoTo, curRecNum
    
End Sub

少し解説すると、現在のカレントレコードと、画面に表示されている先頭行を記憶し、Requery後にGoToRecordを使って復元しています。

2017年10月22日

【PowerShell】Invoke-RestMethodを使って天気予報を取得してみる


最近、Web APIについてちょっと調べてたのですが、そのなかでお天気情報もWeb APIで取得できることが分かり、ためしにPowerShellで取得してみました。

まず、今回使用するWeb APIですが、livedoorの「お天気Webサービス」を使わせていただきました。
http://weather.livedoor.com/weather_hacks/webservice

こういうお天気のWeb APIって有料のところが多く、なかなか無料で使わせてもらえるところは少ないのですが、livedoorの「お天気Webサービス」は個人利用に限って無料で使うことが出来ます。


それではまず、単純にAPIを叩いてお天気情報を取得してみたいと思います。

使い方は簡単です。
Invoke-RestMethodコマンドレットのあとにAPIのURIを指定するだけです。

レスポンスはJSONで返ってきます。




PS C:\work> Invoke-RestMethod http://weather.livedoor.com/forecast/webservice/json/v1?city=140020


pinpointLocations : {@{link=http://weather.livedoor.com/area/forecast/1415000; name=相模原市}, @{link=http://weather.livedoor.com/area/forecast/1415011; name=相
                    模原市西部}, @{link=http://weather.livedoor.com/area/forecast/1415012; name=相模原市東部}, @{link=http://weather.livedoor.com/area/forecast/
                    1420600; name=小田原市}...}
link              : http://weather.livedoor.com/area/forecast/140020
forecasts         : {@{dateLabel=今日; telop=雨; date=2017-10-22; temperature=; image=}, @{dateLabel=明日; telop=雨のち晴; date=2017-10-23; temperature=; image=
                    }, @{dateLabel=明後日; telop=晴時々曇; date=2017-10-24; temperature=; image=}}
location          : @{city=小田原; area=関東; prefecture=神奈川県}
publicTime        : 2017-10-22T11:00:00+0900
copyright         : @{provider=System.Object[]; link=http://weather.livedoor.com/; title=(C) LINE Corporation; image=}
title             : 神奈川県 小田原 の天気
description       : @{text= 前線が本州の南岸に停滞しています。また、台風第21号が日本の南にあ
                    って北北東に進んでいます。

                     神奈川県は、雨となっています。

                     22日は、前線が本州南岸に停滞するため、雨で夜遅くには雷を伴って非
                    常に激しく降る所があるでしょう。

                     23日は、台風第21号の影響で、雨で朝まで雷を伴い非常に激しい雨が
                    降る所がある見込みです。午後は晴れとなる見込みです。

                     神奈川県の海上では、22日はうねりを伴いしけるでしょう。23日はう
                    ねりを伴い猛烈なしけとなる見込みです。船舶は高波に厳重に警戒してくだ
                    さい。; publicTime=2017-10-22T13:34:00+0900}
単純に実行するとこのような感じになるのですが、オブジェクト変数に格納してそれぞれの内容を個別に取得することも簡単に出来ます。

たとえば変数$tenkiに格納してみます。
PS C:\work> $tenki = Invoke-RestMethod http://weather.livedoor.com/forecast/webservice/json/v1?city=140020

ここで、タイトルを取得するには次のようにアクセスします。
PS C:\work> $tenki.title
神奈川県 小田原 の天気

また、予報を取得するには次のようにアクセスします。
PS C:\work> $tenki.forecasts


dateLabel   : 今日
telop       : 雨
date        : 2017-10-22
temperature : @{min=; max=}
image       : @{width=50; url=http://weather.livedoor.com/img/icon/15.gif; title=雨; height=31}

dateLabel   : 明日
telop       : 雨のち晴
date        : 2017-10-23
temperature : @{min=; max=}
image       : @{width=50; url=http://weather.livedoor.com/img/icon/19.gif; title=雨のち晴; height=31}

dateLabel   : 明後日
telop       : 晴時々曇
date        : 2017-10-24
temperature : @{min=; max=}
image       : @{width=50; url=http://weather.livedoor.com/img/icon/2.gif; title=晴時々曇; height=31}


さらに詳しく取得するには、次のようにアクセスします。

明日の天気
PS C:\work> $tenki.forecasts[1].telop
雨のち晴

明日の最低気温(摂氏)
PS C:\work> $tenki.forecasts[1].temperature.min.celsius
20

明日の最高気温(摂氏)
PS C:\work> $tenki.forecasts[1].temperature.max.celsius
26


非常に簡単にデータを取得できましたので、これを使っていろいろ作れそうな気がしますね。
またこんど作ったときに紹介したいと思います。





<関連記事>
天気予報を取得してWindowsフォームに表示する

2017年10月21日

【Access】マウスホイールでフォームのスクロールが出来ない


今日、たまたま気づいたのですが、Accessのフォームでマウスホイールでのスクロールが出来なくなってしまいました。

あれっ、おかしいな?

以前はたしか出来ていたはずなのに。

使用しているのは、Access2016 バージョン 1708 (ビルド 8431.2107)です。
ちなみにOSは、Windows 10 Pro バージョン 1703

ネットで検索したところ同じような症状が出ている人がいました。

その人によるとアップデートしたところ治ったとのこと。

さっそくアップデートしてみました。

⇒バージョン 1709 (ビルド 8528.2139)

2017年10月20日

【Access】フォームOpenをキャンセルする


フォームを開くときに何かの理由でキャンセルしたい場合があったりします。
そういった場合、Openイベントプロシージャの引数CancelをTrueにします。

次の例では、フォームOpen時にInputBoxでパスワードを入力させ、パスワードが一致していた場合だけフォームを開くようにしています。
'パスワード
Private Const PWD As String = "tako"

Private Sub Form_Open(Cancel As Integer)

    Dim pass As String
    
    pass = InputBox("パスワードを入力してください。")
    
    If pass <> PWD Then
    
        MsgBox "パスワードが間違っています。" & vbCrLf & "フォームを開くことが出来ませんでした。", vbExclamation, "警告"
        
        'キャンセル
        Cancel = True
    
    End If
    
End Sub

2017年10月19日

【Access】実行中のフォームのコントロールを再描画する


Repaintメソッドを使って実行中のフォームのコントロールを再描画することが出来ます。

たとえば、フォームにラベル(labelHello)が貼り付けてあり、このラベルのフォントサイズをボタン(buttonBig、buttonSmall)を押すことで変更させてみたいと思います。



各ボタンのイベントプロシージャに次のように記述します。
Private Sub buttonBig_Click()

    Me.labelHello.FontSize = Me.labelHello.FontSize + 1
    
    '再描画
    Me.Repaint
    
End Sub

Private Sub buttonSmall_Click()

    Me.labelHello.FontSize = Me.labelHello.FontSize - 1
    
    '再描画
    Me.Repaint

End Sub

2017年10月18日

【Access】VBAでフォームを作成する


VBAでフォームを作成するにはCreateFormメソッドを使います。

たとえば、このようなaccdbファイルがあったとします。


ここで、次のプロシージャを実行してみます。
Public Sub MakeForm()

    CreateForm
    
    DoCmd.Restore
    
End Sub

2017年10月17日

【Access】最大化/最小化されたフォームを元に戻す


最大化/最小化されたフォームを元に戻すにはDoCmd.Restoreを使います。

たとえば、このようなフォームにボタンが2つ貼り付けてあるとします。


「最大化」ボタンでフォームを最大化、「元に戻す」ボタンでフォームを元に戻すようにするには次のように記述します。
Private Sub buttonMaximize_Click()

    '最大化
    DoCmd.Maximize
    
End Sub

Private Sub buttonRestore_Click()

    '元に戻す
    DoCmd.Restore

End Sub

2017年10月16日

【Access】フォームをスクロールさせる


フォームのGoToPageメソッドを使ってフォームをスクロールさせることが出来ます。

書式

Me.GoToPage ページ番号, 横移動量, 縦移動量

移動量に指定する数値の単位はtwipです。

twipの大きさはおよそ次ように変換できると考えてください。

約567twip = 1cm
約15twip = 1ピクセル


たとえば、このようにフォームにフレームが縦に3つ並んでいるとします。


この各フレームに対してフォームヘッダー部にあるボタンで移動するには次のように記述します。
Private Sub buttonFrame1_Click()

    Me.GoToPage 1, 0, 0

End Sub

Private Sub buttonFrame2_Click()

    Me.GoToPage 1, 0, 4536

End Sub

Private Sub buttonFrame3_Click()

    Me.GoToPage 1, 0, 9072

End Sub

2017年10月15日

画像に矢印とか注釈を入れるソフトScreenpressoを使ってみた

これまでブログに載せる画像に矢印を入れたり、注釈を入れたりするのにGIMPを使っていたのですが、GIMPだと矢印の種類が少なく形もいまいちで、どうにも表現力に乏しすぎてなんとかならないかなと思っていました。

そこでネットでいろいろ調べてみたところ、どうやらみんなSkitchというソフトを使っているということが分かりました。

なるほど!そういうソフトがあったのか。それで早速自分も使ってみようと思い、Skitchのサイトに行ってみました。しかし、どこからダウンロードしていいか分かりません。なぜかいくら探してもどこにもそれらしいのが無いんですよね。

2017年10月14日

【Access】フォームの幅・高さ・位置を変更する


フォームの幅・高さ・位置を変更するには、DoCmd.MoveSizeを使います。

書式

DoCmd.MoveSize 左位置, 上位置, 幅, 高さ

幅や位置に指定する数値の単位はtwipです。

twipの大きさはおよそ次ように変換できると考えてください。

約567twip = 1cm
約15twip = 1ピクセル

たとえば、左位置2cm、上位置2cm、幅10cm、高さ6cmに変更する場合は次のように記述します。
Private Sub Form_Open(Cancel As Integer)

    DoCmd.MoveSize 1134, 1134, 5670, 3402
    
End Sub

2017年10月13日

【Access】フォームを最小化する


フォームを最小化するには、DoCmd.Minimizeを使います。

たとえば、このようなフォームにボタン(buttonMinimize)が付いているとします。


このボタンを押すとフォームが最小化するには次のように記述します。
Private Sub buttonMinimize_Click()

    DoCmd.Minimize
    
End Sub

2017年10月12日

【Access】フォームを最大化する


フォームを最大化するには、DoCmd.Maximizeを使います。

たとえば、このようなフォームにボタン(buttonMaximize)が付いているとします。


このボタンを押すとフォームが最大化するには次のように記述します。
Private Sub buttonMaximize_Click()

    DoCmd.Maximize
    
End Sub

2017年10月11日

【PowerShell】MP3ファイルのファイル名をトラック番号付きのファイル名に変更する


MP3ファイルのファイル名をトラック番号付きのファイル名に変更するスクリプトを作ってみました。

Rename-Mp3File.ps1
param($targetDir)

$sh = New-Object -ComObject Shell.Application
$music = $targetDir
$folder = $sh.Namespace($music) 
$items = Get-ChildItem -Path $music -Include *.mp3 -Name
 
foreach($f in $items)
{
    $fi = $folder.ParseName($f)
 
    #トラック番号取得
    $num = $folder.GetDetailsOf($fi,26).PadLeft(2,"0")
    
    $oldFile = Join-Path $music $f
    $newFile = Join-Path $music ($num + ' ' + $f)

    #ファイル名変更
    Rename-Item $oldFile $newFile
}

Get-ChildItem -Path $music

実行例

たとえばこのようなMP3ファイルが入っているフォルダがあるとします。



引数にこのフォルダを指定し、スクリプトを実行します。
PS C:\work\PowerShell> .\Rename-Mp3File.ps1 C:\work\mp3


    ディレクトリ: C:\work\mp3


Mode                LastWriteTime         Length Name
----                -------------         ------ ----
-a----       2011/04/07     21:32        2215447 01 Black Star.mp3
-a----       2011/04/07     21:33        5350940 02 What The Hell.mp3
-a----       2011/04/07     21:33        5009442 03 Push.mp3
-a----       2011/04/07     21:34        5748950 04 Wish You Were Here.mp3
-a----       2011/04/07     21:35        5255534 05 Smile.mp3
-a----       2011/04/07     21:35        5378378 06 Stop Standing There.mp3
-a----       2011/04/07     21:36        6495746 07 I Love You.mp3
-a----       2011/04/07     21:36        6019979 08 Everybody Hurts.mp3
-a----       2011/04/07     21:37        6512276 09 Not Enough.mp3
-a----       2011/04/07     21:37        5618114 10 4 Real.mp3
-a----       2011/04/07     21:38        5964249 11 Darlin.mp3
-a----       2011/04/07     21:39        7133430 12 Alice (Extended Version).mp3
-a----       2011/04/07     21:39        5588210 13 Remember When.mp3
-a----       2011/04/07     21:40        6297071 14 Goodbye.mp3
-a----       2011/04/07     21:40        5792376 15 What The Hell (Acoustic).mp3
-a----       2011/04/07     21:41        4538096 16 Push (Acoustic).mp3
-a----       2011/04/07     21:41        5675687 17 Wish You Were Here (Acoustic).mp3
-a----       2011/04/07     21:42        3499686 18 Knockin' On Heaven's Door.mp3
-a----       2011/04/07     21:42        4592732 19 Bad Reputation.mp3


ファイル名の先頭にトラック番号が付与されました。







2017年10月10日

【Access】エラーログ処理をクラス化する


以前、エラーログ出力の方法を書きましたが、こういうログ処理というのはクラスにまとめてしまうと使い勝手がよくなります。

LogClass

今回、VBEでクラスモジュールを追加し、名前をLogClassとしました。

プロパティでログファイルの最大サイズやローテーション世代数を設定出来るようにしています。

'定数
Private Const MAX_FILE_SIZE As Long = 4096            'ログファイルサイズ(KB)
Private Const LOG_FILE_NAME As String = "error"       'ログファイル名
Private Const LOG_FILE_EXT As String = "log"          '拡張子名
Private Const LOG_FOLDER As String = "Log"            'フォルダ名
Private Const ROTATE_NUM As Integer = 3               'ログローテーション世代数

'メンバ変数
Private mMaxFileSize As Long                            '最大ログファイルサイズ(KB)
Private mLogFileName As String                          'ログファイル名
Private mLogFileExt  As String                          '拡張子名
Private mLogFolderName As String                        'ログフォルダ名
Private mLogRotateNum As Integer                        'ログローテーション世代数

'Win32API
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystem As SYSTEMTIME)

'構造体
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek  As Integer
    wDay  As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

'プロパティ
Public Property Let MaxFileSize(ByVal Value As Long)
    mMaxFileSize = Value
End Property

Public Property Let LogFileName(ByVal Value As String)
    mLogFileName = Value
End Property

Public Property Let LogFileExt(ByVal Value As String)
    mLogFileExt = Value
End Property

Public Property Let LogFolderName(ByVal Value As String)
    mLogFolderName = Value
End Property

Public Property Let LogRotateNum(ByVal Value As Integer)
    mLogRotateNum = Value
End Property

'クラス初期化処理
Private Sub Class_Initialize()

    'デフォルト値を設定
    mMaxFileSize = MAX_FILE_SIZE
    mLogFileName = LOG_FILE_NAME
    mLogFileExt = LOG_FILE_EXT
    mLogFolderName = LOG_FOLDER
    mLogRotateNum = ROTATE_NUM

End Sub

'エラーログ作成
Public Sub MakeErrorLog(ByRef errObj As ErrObject, _
                        ByVal procName As String)

    Dim errNumber        As Long
    Dim errDescription   As String
    Dim messageLog       As String
    
    'エラー情報を保管
    errNumber = errObj.Number
    errDescription = errObj.Description
    
    'エラーを消去
    errObj.Clear
    
    messageLog = "【エラー番号】" & errNumber & _
              " 【詳細】" & errDescription & _
              " 【発生場所】" & procName
    
    '書き込み
    Call WriteLog(messageLog)
    
    'メッセージボックス表示
    MsgBox errNumber & Space(2) & errDescription, vbCritical, "エラー"

End Sub

'ログ出力
Private Sub WriteLog(ByVal message As String)
On Error GoTo ErrorTrap

    Dim ts, fso         As FileSystemObject
    Dim projectPath     As String
    Dim logFolder       As String
    Dim logFile         As String
    Dim LogFileName     As String
    Dim sysLocalTime    As SYSTEMTIME
    
    
    '現在時刻を取得
    GetLocalTime sysLocalTime
    
    'ログファイル名
    LogFileName = "error.log"
    
    'プロジェクトパスを取得
    projectPath = CurrentProject.Path
    
    'ログ格納フォルダ
    logFolder = projectPath & "\" & mLogFolderName
    
    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ログ格納フォルダの確認(なければ作成)
    If fso.FolderExists(logFolder) = False Then
        'フォルダを作成する
        Call fso.CreateFolder(logFolder)
    End If
    
    'ログファイルフルパス名
    logFile = logFolder & "\" & LogFileName
    
    'ログローテート
    Call LogRotate(logFile)
    
    'ファイルオープン
    Set ts = fso.OpenTextFile(logFile, ForAppending, True)

    '書き込み
    Call ts.WriteLine("[" & sysLocalTime.wYear & "/" & _
                        Format(sysLocalTime.wMonth, "00") & "/" & _
                        Format(sysLocalTime.wDay, "00") & " " & _
                        Format(sysLocalTime.wHour, "00") & ":" & _
                        Format(sysLocalTime.wMinute, "00") & ":" & _
                        Format(sysLocalTime.wSecond, "00") & "." & _
                        Format(sysLocalTime.wMilliseconds, "000") & "] " & message)
                      
    'ファイルクローズ
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
    
Exit Sub
ErrorTrap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
End Sub

'ログローテート
Private Sub LogRotate(ByVal fileName As String)
On Error GoTo Err_Trap

    Dim fso        As FileSystemObject
    Dim i          As Integer
    Dim r          As Integer
    Dim folderPath As String
    Dim srcFile    As String
    Dim destFile   As String
    Dim oldestFile As String
    Dim checkFile  As String
    Dim fileSize   As Long

    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ファイルが存在するかチェック
    If fso.FileExists(fileName) = False Then
        Exit Sub
    End If

    'ファイルサイズを取得する
    fileSize = fso.GetFile(fileName).Size

    'ファイルサイズをチェック
    If fileSize < mMaxFileSize * 1024 Then
        '最大サイズを超えてなければ処理を抜ける
        Exit Sub
    End If

    'フォルダパスを取得
    folderPath = fso.GetParentFolderName(fileName)

    '最古ファイルパス
    oldestFile = folderPath & "\" & mLogFileName & mLogRotateNum & "." & mLogFileExt

    '最古ファイルが存在すれば削除
    If fso.FileExists(oldestFile) Then
        Call fso.DeleteFile(oldestFile)
        r = mLogRotateNum - 1
    Else
        'ローテーション世代数を調べる
        For r = (mLogRotateNum - 1) To 0 Step -1
            If r = 0 Then
                checkFile = folderPath & "\" & mLogFileName & "." & mLogFileExt
            Else
                checkFile = folderPath & "\" & mLogFileName & r & "." & mLogFileExt
            End If

            If fso.FileExists(checkFile) Then
                Exit For
            End If
        Next
    End If

    'ファイル名をローテーションする
    For i = r To 0 Step -1
        If i = 0 Then
            srcFile = folderPath & "\" & mLogFileName & "." & mLogFileExt
        Else
            srcFile = folderPath & "\" & mLogFileName & i & "." & mLogFileExt
        End If

        destFile = folderPath & "\" & mLogFileName & i + 1 & "." & mLogFileExt

        If fso.FileExists(srcFile) Then
            'ファイル名変更
            Call fso.MoveFile(srcFile, destFile)
        End If
    Next

Exit_Trap:

    Set fso = Nothing

Exit Sub
Err_Trap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
    Resume Exit_Trap
End Sub

2017年10月9日

【Access】ログファイルをローテーションする


ログファイルにどんどん追記していくと際限なくファイルサイズが増大していってしまいます。そこでログファイルがある一定のファイルサイズを超えたらローテーションして古いファイルを削除したりして増大するのを防ぎます。

標準モジュール

今回、標準モジュールに下記のようなプロシージャを作成しました。
ログファイルの最大サイズ、ログファイル名、ログファイルの拡張子、あとローテーション世代数を定数で設定しています。

ローテートは、最大サイズを超えたらファイル名に数字をプラスしていきます。そして、ローテーション世代数を超えたファイルは削除するようにしています。

error.log

error1.log

error2.log

error3.log

削除

'定数
Private Const MAX_FILE_SIZE As Long = 4096            'ログファイルサイズ(KB)
Private Const LOG_FILE_NAME As String = "error"       'ログファイル名
Private Const LOG_FILE_EXT  As String = "log"         '拡張子名
Private Const ROTATE_NUM As Integer = 3               'ログローテーション世代数

'ログローテート
Public Sub LogRotate(ByVal fileName As String)
On Error GoTo Err_Trap

    Dim fso        As FileSystemObject
    Dim i          As Integer
    Dim r          As Integer
    Dim folderPath As String
    Dim srcFile    As String
    Dim destFile   As String
    Dim oldestFile As String
    Dim checkFile  As String
    Dim fileSize   As Long

    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ファイルが存在するかチェック
    If fso.FileExists(fileName) = False Then
        Exit Sub
    End If

    'ファイルサイズを取得する
    fileSize = fso.GetFile(fileName).Size

    'ファイルサイズをチェック
    If fileSize < MAX_FILE_SIZE * 1024 Then
        '最大サイズを超えてなければ処理を抜ける
        Exit Sub
    End If

    'フォルダパスを取得
    folderPath = fso.GetParentFolderName(fileName)

    '最古ファイルパス
    oldestFile = folderPath & "\" & LOG_FILE_NAME & ROTATE_NUM & "." & LOG_FILE_EXT

    '最古ファイルが存在すれば削除
    If fso.FileExists(oldestFile) Then
        Call fso.DeleteFile(oldestFile)
        r = ROTATE_NUM - 1
    Else
        'ローテーション世代数を調べる
        For r = (ROTATE_NUM - 1) To 0 Step -1
            If r = 0 Then
                checkFile = folderPath & "\" & LOG_FILE_NAME & "." & LOG_FILE_EXT
            Else
                checkFile = folderPath & "\" & LOG_FILE_NAME & r & "." & LOG_FILE_EXT
            End If

            If fso.FileExists(checkFile) Then
                Exit For
            End If
        Next
    End If

    'ファイル名をローテーションする
    For i = r To 0 Step -1
        If i = 0 Then
            srcFile = folderPath & "\" & LOG_FILE_NAME & "." & LOG_FILE_EXT
        Else
            srcFile = folderPath & "\" & LOG_FILE_NAME & i & "." & LOG_FILE_EXT
        End If

        destFile = folderPath & "\" & LOG_FILE_NAME & i + 1 & "." & LOG_FILE_EXT

        If fso.FileExists(srcFile) Then
            'ファイル名変更
            Call fso.MoveFile(srcFile, destFile)
        End If
    Next

Exit_Trap:

    Set fso = Nothing

Exit Sub
Err_Trap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
    Resume Exit_Trap
End Sub

実際のローテートする部分だけです。
このプロシージャをログファイル作成時に呼び出してあげればローテートしてくれます。

2017年10月8日

Embedlyを使ってブログカードを作ってみた

以前からほかのブログとかを見てると、埋め込みでサムネイル付きのリンクが貼り付けてあって、こういうの自分もやってみたい!って思っていたのですが、調べてみると「はてなカード」と言って、はてなブログ用のサービスらしいんです。

このブログはBloggerですので、残念ながら「はてなカード」は使えないんですよね。

そこで他に何かいい方法はないかと探してみたところ、今日、Embedlyというサービスを見つけました。

試しにブログカードを作ってみましたので、その使い方をちょっとご紹介したいと思います。

2017年10月7日

【Access】エラーログを出力する


システムでエラーが発生したときにファイルにエラーログを出力する方法です。

参照設定

まず、今回ファイルの作成やフォルダの作成にFileSystemObjectオブジェクトを使ので参照設定で「Microsoft Scripting Runtime」を選択してください。


標準モジュール

次に標準モジュールに下記のように記述します。
'Win32API
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystem As SYSTEMTIME)

'構造体
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek  As Integer
    wDay  As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

'エラーログ作成
Public Sub MakeErrorLog(ByRef errObj As ErrObject, _
                        ByVal procName As String)

    Dim errNumber        As Long
    Dim errDescription   As String
    Dim messageLog       As String
    
    'エラー情報を保管
    errNumber = errObj.Number
    errDescription = errObj.Description
    
    'エラーを消去
    errObj.Clear
    
    messageLog = "【エラー番号】" & errNumber & _
              " 【詳細】" & errDescription & _
              " 【発生場所】" & procName
    
    '書き込み
    Call WriteLog(messageLog)
    
    'メッセージボックス表示
    MsgBox errNumber & Space(2) & errDescription, vbCritical, "エラー"

End Sub

'ログ出力
Private Sub WriteLog(ByVal message As String)
On Error GoTo ErrorTrap

    Dim ts, fso         As FileSystemObject
    Dim projectPath     As String
    Dim logFolder       As String
    Dim logFile         As String
    Dim logFileName     As String
    Dim sysLocalTime    As SYSTEMTIME
    
    
    '現在時刻を取得
    GetLocalTime sysLocalTime
    
    'ログファイル名
    logFileName = "error.log"
    
    'プロジェクトパスを取得
    projectPath = CurrentProject.Path
    
    'ログ格納フォルダ
    logFolder = projectPath & "\Log"
    
    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ログ格納フォルダの確認(なければ作成)
    If fso.FolderExists(logFolder) = False Then
        Call fso.CreateFolder(logFolder)
    End If
    
    'ログファイルフルパス名
    logFile = logFolder & "\" & logFileName
    
    '追記モードでファイルオープン
    Set ts = fso.OpenTextFile(logFile, ForAppending, True)

    '書き込み
    Call ts.WriteLine("[" & sysLocalTime.wYear & "/" & _
                        Format(sysLocalTime.wMonth, "00") & "/" & _
                        Format(sysLocalTime.wDay, "00") & " " & _
                        Format(sysLocalTime.wHour, "00") & ":" & _
                        Format(sysLocalTime.wMinute, "00") & ":" & _
                        Format(sysLocalTime.wSecond, "00") & "." & _
                        Format(sysLocalTime.wMilliseconds, "000") & "] " & message)
                      
    'ファイルクローズ
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
    
Exit Sub
ErrorTrap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
End Sub
今回、MakeErrorLogの引数にErrオブジェクトを渡してエラー番号とエラーの詳細をログに出力するようにしています。また、プロシージャ名を渡してどこでエラーが発生したかもログに残すようにしています。

実際のファイルに出力する部分は、FileSystemObjectオブジェクトを使って行っています。ファイルは追記モードで開き、発生時刻はWin32APIを使いミリ秒まで出すようにしました。

2017年10月6日

【Access】マウスポインターの形状を変更する


通常、Accessでマウスカーソルを砂時計に変更するにはDoCmd.Hourglassを使いますが、ScreenオブジェクトのMousePointerプロパティを使っても変更することが出来ます。


MousePointer プロパティの設定値

設定値 内容
0既定値
1標準の選択 (矢印)
3テキスト選択 (I字型ポインター)
7上下に拡大/縮小
9左右に拡大/縮小
11待ち状態 (砂時計)

1 矢印

Application.Screen.MousePointer = 1




3 I字型ポインター

Application.Screen.MousePointer = 3




7 上下に拡大/縮小

Application.Screen.MousePointer = 7




9 左右に拡大/縮小

Application.Screen.MousePointer = 9




11 待ち状態 (砂時計)

Application.Screen.MousePointer = 11









2017年10月5日

【Access】エラー発生時の終了処理


そのプロシージャを終わらせるにあたって実行しなければいけない処理というのがある場合があります。たとえば、データベースへの接続オブジェクトのクローズ処理だったり、戻り値の設定をすることだったり。ただ、エラーが発生してしまい途中でエラー処理に飛ばされてしまうことがあります。

そのような場合、エラー処理を行ったあとにResumeステートメントで終了処理に飛ばしてあげます。

下記の例では、マウスカーソルを砂時計に変更し、エラー発生時でも必ずマウスカーソルを元に戻すようにしています。
Public Sub ExitTest()
On Error GoTo Err_Trap

    'マウスを砂時計に切り替える
    DoCmd.Hourglass True
    
    Dim a As Long
    
    a = 30 / 0

    MsgBox "a = " & a

Exit_Trap:
    
    '終了処理

    'マウスを元に戻す
    DoCmd.Hourglass False

Exit Sub
Err_Trap:
    MsgBox "エラー番号:" & Err.Number & vbCrLf & vbCrLf & Err.Description, vbExclamation, "エラー"
    Resume Exit_Trap
End Sub
ポイントは、Err_Trapラベル後のメッセージボックスを表示したあとにResumeステートメントでExit_Trapラベルに処理を飛ばしているところです。
Resumeステートメントでラベルを指定すると、そのラベルに処理を移動できるようになっています。






2017年10月4日

【PowerShell】ファイルの拡張子を一括で変更するスクリプト


ファイルの拡張子を一括で変更するスクリプトを作ってみました。

「Change-FileExtension.ps1」
#引数(該当フォルダ, 変更前拡張子, 変更後拡張子)
param($targetDir, $oldExt, $newExt)

#正規表現の指定
$matStr = '.' + $oldExt
$oldStr = '\.'+ $oldExt + '$'
$newStr = '.' + $newExt

#該当するファイルの拡張子を置換
Get-ChildItem -Path $targetDir | Where-Object {$_.Extension -eq $matStr} | Rename-Item -NewName { $_.Name -replace $oldStr, $newStr }

実行例

たとえばフォルダ(C:\work\test)にこのようなファイルがあるとします。



このファイルの拡張子を「log」から「txt」に一括で変更するには次のよう引数を指定します。
引数は左から「該当フォルダ」「変更前拡張子」「変更後拡張子」。
PS C:\work\access> .\Change-FileExtension.ps1 C:\work\test log txt


実行するとこのように拡張子が一括で変更されます。







2017年10月3日

【Access】エラー処理


システム開発をする上で重要になってくるのがエラー処理です。エラー処理を正しく行っていないとエラーによりAccess自体を強制終了しなければいけないといったことになってしまうことがあります。

Access VBAのエラー処理は2つの方法があり、一つはエラーが起きても無視して処理を続行させる方法と、もう一つはエラーが起きたら特定の行に処理を移す方法があります。

エラーが起きても無視して処理を続行させる方法

まずは何もエラー処理してない場合です。下記のコードは0除算エラーが発生します。
Public Sub ErrorResumeTest()

    Dim a As Long
    
    a = 30 / 0
    
    MsgBox "a = " & a

End Sub

実行するとこのように「0で除算しました。」というエラーが出てプログラムが停止してしまいます。



次はこのコードに下記のように「On Error Resume Next」ステートメントを追加してみます。
Public Sub ErrorResumeTest()
On Error Resume Next

    Dim a As Long
    
    a = 30 / 0
    
    MsgBox "a = " & a

End Sub

実行結果


「On Error Resume Next」を追加すると、実行時エラーを無視するようになり、次のステートメントに処理を移しプログラムの実行を継続させます。


エラーが起きたら特定の行に処理を移す方法

次にエラーが起きた場合に特定の行に処理を移す方法です。下記のコードでは、「On Error GoTo」ステートメントを使ってエラーが起きた際に処理を移動させています。
Public Sub ErrorGotoTest()
On Error GoTo Err_Trap

    Dim a As Long
    
    a = 30 / 0

    MsgBox "a = " & a

Exit Sub
Err_Trap:
    MsgBox "エラー番号:" & Err.Number & vbCrLf & vbCrLf & Err.Description, vbExclamation, "エラー"
End Sub
GoToで指定した「Err_Trap」というラベルに処理を飛ばすようにしています。これによりプログラムを停止することなくエラーメッセージを表示させたりすることが出来るようになります。

また、注意してほしいのは、「Err_Trap」ラベルの前には「Exit Sub」などの終了処理を入れてください。そうしないとエラーが発生してないときもエラーメッセージが表示されてしまいます。


実行結果