社内システムの自作なら、すず工房へ!!
エクセル仕事術などでIT経営を支援します
  • Home
  • エクセル仕事術
  • クラウド生産管理
  • サービス案内
  • つぶやきました
  • お問合せ
  • すず工房
  • 名刺

進行表示の3つの方法

2011年12月07日

長い時間を要する処理をしている間は、マウスカーソルを[砂時計]にしたり、進行の程度(現在どこまで進んでいるのかや、あとどれくらいかかるのか)を表示すると、ユーザに親切です。

そんな進行表示の方法を、三種類紹介します。

1.ステータスバー その1


Excelにはそんな表示をするためのStatusBarというおApplication.StatusBar プロパティがあります。


Application.StatusBar プロパティの仕様は、VBAのヘルプをみてください。


以下、使用例です。  



Option Explicit


Dim oldstatusbar As Variant


Public abortFlag As Boolean


 


Public Sub setStatusBar(msg As Variant)


    'ステータスバー表示


    With Application


        oldstatusbar = .DisplayStatusBar


        .DisplayStatusBar = True


        .StatusBar = msg


    End With


End Sub


 


Public Sub msgStatusBar(msg As Variant)


    With Application


        .StatusBar = msg


    End With


End Sub


 


Public Sub resetStatusBar()


    'ステータスバー復帰


    With Application


        .StatusBar = False


        .DisplayStatusBar = oldstatusbar


    End With


End Sub


 

進行表示のテストプログラムです。

 

 

Public Sub progressbar11()

    'StatusBarで進行表示その1

    Dim idx As Long

    Const idxmax As Long = 20

    Dim tm As Variant

    

    'Excelウィンドウの左下にあるステータスバーを初期化する

    Call setStatusBar("しばらくお待ちください‥")

    

    For idx = 0 To idxmax

        'ステータスバーにメッセージを表示する

        Call msgStatusBar("しばらくお待ちください‥" & idx & "/" & idxmax)

        

        '**********

        ' 本来の繰り返し処理がここに入る

        '**********

        

        '**********

        ' 本来の繰り返し処理の代わり

        tm = Timer() 'システムのタイマー

        Do Until Timer() - tm > 1

            DoEvents '1 秒経過するまで待つ

        Loop

        '**********

        

    Next idx

    

    'ステータスバーをリセットする

    Call resetStatusBar

 

End Sub

結果は次のとおりです。

 


 

どうですか?とても簡単に使えますよね。動作の負荷もあまりかからないし、手軽に使えて便利です。 その反面、なんだか物足りなさも感じます。

2.ステータスバー その2

 

今度は、同じステータスバーですが、少しグラフィカルっぼくしてみます。

 

 

Public Function initStrBar(barLength As Long) As Variant

 

    initStrBar = String(barLength, "□")

 

End Function

 

Public Function setStrBar(crntValue As Long, maxValue As Long, barLength As Long) As Variant

 

    setStrBar = String(CInt(barLength * crntValue / maxValue), "■") _

                & String(barLength - CInt(barLength * crntValue / maxValue), "□")

                

End Function

 

Public Sub progressbar12()

    'StatusBarで進行表示 その2

    Dim idx As Long

    Const idxmax As Long = 20

    Dim tm As Variant

    Const prgrsmax As Long = 30

    

    

    'Excelウィンドウの左下にあるステータスバーを初期化する

    Call setStatusBar(initStrBar(prgrsmax))

    

    For idx = 0 To idxmax

        'ステータスバーにバーを表示する

        Call msgStatusBar(setStrBar(idx, idxmax, prgrsmax))

        

        '**********

        ' 本来の繰り返し処理がここに入る

        '**********

        

        '**********

        ' 本来の繰り返し処理の代わり

        tm = Timer() 'システムのタイマー

        Do Until Timer() - tm > 1

            DoEvents '1 秒経過するまで待つ

        Loop

        '**********

        

    Next idx

    

    'ステータスバーをリセットする

    Call resetStatusBar

 

End Sub

実行結果は次のとおり。

 


 

少しはグラフィカルになったでしようか?

まだまだですかね??

3. フォームを使ったプログレスバー
では自前のプログレスバーです。
 
以下のように、まず、ユーザフォームを挿入します。
 
lblBackをlblFrontのうしろに、図のように配置します。ここではコントロールの大きさは橙でかまいません。

ユーザフォームのプログラムです。


Option Explicit
 
Public widthmax As Long
 
Private Sub cmdAbort_Click()
    abortFlag = True
End Sub
 
Private Sub UserForm_Initialize()
    
    With txtMsg
        .BackColor = &H8000000F
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &H8000000F
        .Text = ""
    End With
    
    With txtProgressbar
        .BackColor = &H8000000F
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &H8000000F
        .Text = ""
    End With
    
    With lblBack
        .BackColor = &H8000000F
        widthmax = .Width - 2 * 1
    End With
    
    With lblFront 'サイズを調節します
        .Left = lblBack.Left + 1
        .Top = lblBack.Top + 2
        .Height = lblBack.Height - 2 * 2
        .Width = 0
        
        .BackColor = &H8000&
        
        .Caption = ""
        .TextAlign = fmTextAlignCenter
    End With
    
End Sub
 
Private Sub UserForm_Terminate()
    abortFlag = True
End Sub
 
 
次に進行表示のプログラム。
 
 
Public Sub progressbar21()
    'ユーザフォームで進行表示
    Dim idx As Long
    Const idxmax As Long = 20
    Dim tm As Variant
    Dim wdmax As Long
    
    With frmProgress
        'フォームを初期化後表示する
        
        wdmax = .widthmax 'フォームからラベルの表示幅を取得
        
        .txtMsg.Text = "しばらくお待ちください‥"
        
        'フォームを表示
        ' → modelessなので表示したまま他の(show 以下の)処理を実行可能
        '   ただし、Modalで表示しているフォームから、さらにmodelessで
        '   フォームを表示することはできない
        
        .Show vbModeless
        
        
        abortFlag = False '中止フラグを初期化
        For idx = 0 To idxmax
            
            If abortFlag Then
                '中止ボタンが押されたら、中止
                Exit For
            End If
        
            'プログレスバーを表示
            With .lblFront
                .Width = wdmax * idx / idxmax
            End With
            With .txtProgressbar
                .Text = idx & "/" & idxmax
            End With
            
            '**********
            ' 本来の繰り返し処理がここに入る
            '**********
        
            '**********
            ' 本来の繰り返し処理の代わり
            tm = Timer() 'システムのタイマー
            Do Until Timer() - tm > 1
                DoEvents '1 秒経過するまで待つ
            Loop
            '**********
            
        Next idx
    End With
       
    'フォームを削除する
    Unload frmProgress
    Set frmProgress = Nothing
 
End Sub

実行結果は以下のとおりです。

  • 仕事に生かすExcel
  • マクロ・VBA
    • Excel2013のSDIへの対応
    • WEBからデータをVBAで取込む
    • 選択したセル範囲を取出すには
    • 消費税率を読込むDLL
    • インターネット上のサイトのデータを読み込む
    • 右ボタンでのMouseDownイベントには要注意
    • CSVファイルを読みこむ(Excel)
    • テキストファイル読込速度比較
    • 進行表示の3つの方法
    • IsDate関数はおかしい‥
    • 別のワークブックのデータを読み込む
    • 2 つの指定した日付の時間間隔と満年齢
    • ワークシートのセルに特定のデータを入力する
    • CSVファイルからデータを取り出す
    • ワークシートからデータを取得する
    • ワークシートにデータをセットする
    • 特定のセル範囲からデータを探す方法を比較する
  • Excelの操作

コンタクト

メール
メール
FaceBook
FaceBook

つぶやきました

見える生産管理2022

2022年 10月 31日 月

久しぶりの投稿になってしまいましたが、「見える生産管理2022」を試用できるようになりました。「クラウド生産管理」メニュからご覧ください。

0 コメント

Webデータベース利用の生産管理

2019年 7月 22日 月

いままでExcel(R)を活用した生産管理システムを構築したり構築支援したりしてきましたが、もっと簡単に生産管理を開始できないかと考え、Webに登場してきたデータベースを利用して生産管理できるシステムを考えました。

 

続きを読む 0 コメント

iPadのSIM

2018年 11月 16日 金

iPad Pro 12.9を外出時の仕事用に使っていたが、自宅のMACにリモートアクセスするのがベストに近いかもと気づき、4G回線経由だがやってみた。

しかしこれがかなり遅い。SIMは前の機種で使ってたイオンモバイルのやつ。これが原因かもと思い、一番早いと噂のUQ  Mobileに変えてみた。体感的にはちょっと早いかなという感じ。これからじっくり検証していこうと思う。

 

インターネット接続の設定でつまづいたので以下に備忘録として残しておく。

 

 

続きを読む
プライバシーポリシー | サイトマップ
Copyright © 2002- すず工房. All Rights Reserved.
ログアウト | 編集
  • Home
  • エクセル仕事術
    • 仕事に生かすExcel
      • Excelでできること
      • ExcelからSQLiteを使う理由
    • マクロ・VBA
      • Excel2013のSDIへの対応
      • WEBからデータをVBAで取込む
      • 選択したセル範囲を取出すには
      • 消費税率を読込むDLL
      • インターネット上のサイトのデータを読み込む
      • 右ボタンでのMouseDownイベントには要注意
      • CSVファイルを読みこむ(Excel)
      • テキストファイル読込速度比較
      • 進行表示の3つの方法
      • IsDate関数はおかしい‥
      • 別のワークブックのデータを読み込む
      • 2 つの指定した日付の時間間隔と満年齢
      • ワークシートのセルに特定のデータを入力する
      • CSVファイルからデータを取り出す
      • ワークシートからデータを取得する
      • ワークシートにデータをセットする
      • 特定のセル範囲からデータを探す方法を比較する
    • Excelの操作
      • ふりがなをつける
      • 行・列を固定してスクロール
      • 他のシートのデータを表示する-カメラ機能
      • 文章を指定範囲に収まるように整形する
  • クラウド生産管理
    • 見える生産管理2022
    • 見える生産管理K(簡易版)
    • 試用申込み
  • サービス案内
    • IT経営
  • つぶやきました
    • MAC
    • IT
    • その他
    • 年月別
      • 2022/10
      • 2019/07
      • 2016/07
      • 2016/04
      • 2015/11
      • 2015/10
      • 2015/08
      • 2015/07
      • 2015/06
      • 2015/03
      • 2015/02
      • 2014/12
      • 2014/03
      • 2013/09
      • 2012/11
      • 2012/09
      • 2010/09
      • 2010/08
      • 2010/07
      • 2010/06
      • 2010/03
      • 2010/02
      • 2009/05
      • 2009/04
  • お問合せ
  • すず工房
    • 企業理念
    • 主な資格
    • 実績
  • 名刺
  • トップへ戻る