【VBA】Officeの64bit版ではプログレスバーが使えないらしいので自作した

【VBA】Officeの64bit版ではプログレスバーが使えないらしいので自作した

AccessのVBAで作成したプログラムが、ある日を境に毎回エラーが出るようになってしまったそうです。

自分のPCで実行してみても正常に動くため、原因が何なのかが全然分からなかったのですが、どうやらOfficeに違いがあるようでした。

32bit版で作成したVBAのプログラムにはプログレスバーがあったのですが、64bit版ではプログレスバーが使えないんだとか。

64bit版でプログレスバーを使用する方法を調べても怪しいものがほとんどだったため、それっぽいのを自作することになりました。

 

まず、プログレスバーの背景として横長のラベルを作ります。

名前は「labelProgressBar_back」としました。

次に、プログレスバーの進捗部分を表すラベルを作ります。

位置と高さを背景のものと一致させ、幅を小さくします。

また、それっぽく見えるように色を青に設定しました。

こちらの名前は「labelProgressBar」としました。

文字列がないとラベルが消えてしまうようだったため、空白を入れてあります。

あとは進捗に合わせて伸び縮みするようにするだけですね。

標準モジュールでプログレスバーっぽく見せるためのソースです。

「MyProggressBar」というモジュール名にしました。

Private parentBar As Object
Private progressBar As Object
Private max

'******************************************************************
'
' 親と子を設定する
'
'******************************************************************
Public Sub setProggressBar(ByRef parent, ByRef child)

    ' 親を設定する
    Set parentBar = parent
    ' 子を設定する
    Set progressBar = child

    ' 初期設定を行う
    initProgressBar

End Sub

'******************************************************************
'
' MAXをセットする
'
'******************************************************************
Public Sub setMaxValue(ByVal value)

    ' MAXを設定する
    max = value

End 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 If
End Sub


'******************************************************************
'
' 親と子を設定する
'
'******************************************************************
Private Sub initProgressBar()

    ' 子の長さを0にする
    progressBar.Width = 0

End Sub

こんな感じに使います。

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)の段階で背景と同じ長さになります。

小数点以下を考えずに作成されているため、気になる方は自分で補正してください。

他にやり方があるのかもしれませんが、時間と元気がないのでこんな仕上がりになりました。