Segmentation Fault

コアダンプの数だけ強くなれるよ、デスマと戦うエンジニアのように。

エクセルでプログレスバーを表示する

エクセルのマクロ(VBA)で処理の進捗状況を表示する。

プログレスバーのフォーム作成

フォームの追加

f:id:segmentation-fault:20170303233616p:plain


コントロールボックスにプログレスバーを追加

f:id:segmentation-fault:20170303233642p:plain

f:id:segmentation-fault:20170303233749p:plain

f:id:segmentation-fault:20170303233801p:plain


ラベル、ボタン、バーを追加してそれっぽく作成

f:id:segmentation-fault:20170303233846p:plain

ソースコード作成

UserFormに中断ボタン実行を判定するフラグを追加する。

UserForm

'中断ボタン実行フラグ
Public IsCancel As Boolean

Private Sub CommandButton1_Click()
  '中断ボタン実行でフラグをオン
  IsCancel = True

End Sub

Private Sub Label1_Click()

End Sub


Private Sub ProgressBar1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)


End Sub

Private Sub UserForm_Click()

End Sub

Moduleにプログレスバー表示処理を追加

Main Module

'Sleepを使うための定義
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If


Sub ProgressBar()
  
  Const MaxCount As Long = 100
  
  UserForm2.Show P_bar
  UserForm2.ProgressBar1.Min = 1
  UserForm2.ProgressBar1.Max = MaxCount
  
  UserForm2.IsCancel = False
  
  Dim index As Long
  Dim progress As Long
  For index = 1 To MaxCount
  
    Sleep (100)
    
    progress = CInt((index / MaxCount) * 100)
    UserForm2.Label1.Caption = index & "%完了"
    UserForm2.ProgressBar1.Value = index
  
    If UserForm2.IsCancel = True Then
      End
    End If
  
    DoEvents
    
  Next
  
  Unload UserForm2

End Sub

実行結果

f:id:segmentation-fault:20170303234347p:plain