【VBA】Officeの64bit版ではプログレスバーが使えないらしいので自作した
AccessのVBAで作成したプログラムが、ある日を境に毎回エラーが出るようになってしまったそうです。
自分のPCで実行してみても正常に動くため、原因が何なのかが全然分からなかったのですが、どうやらOfficeに違いがあるようでした。
32bit版で作成したVBAのプログラムにはプログレスバーがあったのですが、64bit版ではプログレスバーが使えないんだとか。
64bit版でプログレスバーを使用する方法を調べても怪しいものがほとんどだったため、それっぽいのを自作することになりました。
まず、プログレスバーの背景として横長のラベルを作ります。
名前は「labelProgressBar_back」としました。
次に、プログレスバーの進捗部分を表すラベルを作ります。
位置と高さを背景のものと一致させ、幅を小さくします。
また、それっぽく見えるように色を青に設定しました。
こちらの名前は「labelProgressBar」としました。
文字列がないとラベルが消えてしまうようだったため、空白を入れてあります。
あとは進捗に合わせて伸び縮みするようにするだけですね。
標準モジュールでプログレスバーっぽく見せるためのソースです。
「MyProggressBar」というモジュール名にしました。
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 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | Private parentBar As ObjectPrivate progressBar As ObjectPrivate max'******************************************************************'' 親と子を設定する''******************************************************************Public Sub setProggressBar(ByRef parent, ByRef child) ' 親を設定する Set parentBar = parent ' 子を設定する Set progressBar = child ' 初期設定を行う initProgressBarEnd Sub'******************************************************************'' MAXをセットする''******************************************************************Public Sub setMaxValue(ByVal value) ' MAXを設定する max = valueEnd Sub'******************************************************************'' 進捗状況をセットする''******************************************************************Public Sub setValue(ByVal value) Dim tmpWidth ' 1単位あたりの横幅を取得する tmpWidth = parentBar.Width / max If Err.Number <> 0 Then Exit Sub End If ' 進捗状況を設定する progressBar.Width = tmpWidth * value If Err.Number <> 0 Then Exit Sub End If ' 親の横幅を超える場合は親の横幅に合わせる If parentBar.Width < progressBar.Width Then progressBar.Width = parentBar.Width End If If Err.Number <> 0 Then Exit Sub End IfEnd Sub'******************************************************************'' 親と子を設定する''******************************************************************Private Sub initProgressBar() ' 子の長さを0にする progressBar.Width = 0End Sub |
こんな感じに使います。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | Dim i As Integer' プログレスバーとして扱うラベルを設定するCall MyProggressBar.setProggressBar(Me.labelProgressBar_back, Me.labelProgressBar)' 進捗の最大値を設定するMyProggressBar.setMaxValue (20)' 進捗に値を設定する(1/20)MyProggressBar.setValue (1)' ----- 処理1 -----' 進捗に値を設定する(2/20)MyProggressBar.setValue (2)' ----- 処理2 -----' MyProggressBar.setValue (20)まで設定可能 |
setValue(20)の段階で背景と同じ長さになります。
小数点以下を考えずに作成されているため、気になる方は自分で補正してください。
他にやり方があるのかもしれませんが、時間と元気がないのでこんな仕上がりになりました。
No comments.