Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


40928 / 76732 ←次へ | 前へ→

【40893】Re:ラベルの文字について
発言  ichinose  - 06/7/25(火) 19:54 -

引用なし
パスワード
   こんばんは。
お二人からのご質問ですが、
まず、もう一つ例を出します。

新規ブックにユーザーフォームを作成してください。


ユーザーフォーム----Userform1
    ラベル---------Label1
    ボタン---------Commandbutton1

標準モジュールには、

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40820;id=excel

ここで記述した二つの標準モジュールをそのままコピーしてください。


Userform1のモジュールに

'===============================================================
Option Explicit

Private Sub CommandButton1_Click()
  Dim filepath As String
  Dim rw As Long
  Dim flnm As String
  Call disp_open(Label1, "処 理 中", 100)
'                      ↑ここの数字はお好みで      
  flnm = Dir("C:\Documents and Settings\ichinose\Favorites\*.*")
' ここは、それぞれファイルが沢山あるフォルダ名を指定してください
  Do Until flnm = ""
    Cells(rw + 1, 1).Value = flnm
    rw = rw + 1
    Call disp_proc
    DoEvents
    flnm = Dir()
    Loop
  Call disp_close
  
End Sub


として、mainを実行してみてください
上記のコードはユーザーフォームが表示されます。

ボタンをクリックすると、
指定されたフォルダ内にあるファイル名を
アクティブシートのA列に列挙します。

その処理中にユーザーフォームには
「処 理 中」というメッセージが流れます。

全てのファイル名の表示されるとメッセージが消えます。


というコードです。

このラベル上を動く「処 理 中」というメッセージですが、
教科書のページの隅に書いた漫画をペラペラして動いているように見せる、
子供ころ誰でもやりましたよね!!
あれと同じ原理でラベル上で動いているように見せています。


上記のコードの

  Do Until flnm = ""
    Cells(rw + 1, 1).Value = flnm
    rw = rw + 1
    Call disp_proc
    DoEvents
    flnm = Dir()
    Loop
このループ内(Do UntilとLoopの間)のコードは、1秒も満たない速さで
処理されます。
その都度、disp_procというプロシジャーが呼び出されて
「処 理 中」という文字をひとコマづつ移動させています。

つまり、このループの中で繰り返しdisp_procというプロシジャーを
呼び出すことで「処 理 中」という文字が動いているように見えるのです。

これがある程度のスピードで動いているように見えるためには、
ループ内のコードの処理速度がある程度高速でなくてはなりません。

ループ内のコードが1時間もかかっていては、一時間に1回しか
disp_procは呼び出されません。

これでは、文字が流れているようには見えませんよね?


以上を理解していただいて、再度、ご自分が抱えている
コードがこの文字が流れるコードに適しているのか
判断してみてください。

ちょっと見た限りですが、
horiさんのコードは、本来、ループ内で処理するコードではないですね!!
ページ設定は結構それぞれのプロパティ設定が時間がかかるので
間にいくつも

  Call disp_proc
  DoEvents
を挿入していくということです。

Private Sub CommandButton1_Click()
  Call disp_open(Label1, "処理中しばらくお待ちください", 200)
  Range("A1:G95").Select
  Call disp_proc
  DoEvents
  Range("G95").Activate
  Call disp_proc
  DoEvents
  ActiveSheet.PageSetup.PrintArea = "$A$1:$G$95"
  Call disp_proc
  DoEvents
  With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$2"
  End With
  Call disp_proc
  DoEvents
  ActiveSheet.PageSetup.PrintArea = "$A$1:$G$95"
  With ActiveSheet.PageSetup
    .RightHeader = "&""MS P明朝,標準""&9P-&P"
    Call disp_proc
     DoEvents
    .CenterFooter = "&""MS P明朝,標準""&8株式会社"
    Call disp_proc
     DoEvents

    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlPortrait
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .PrintErrors = xlPrintErrorsDisplayed
  end with
  Call disp_proc
  DoEvents
  Call disp_close
  Label1.Caption = ""
End Sub

試してみてください。
因みに
>コンパイルエラーloopに対するDoがありません

は対になっている構文が対になっていないからです。


tkの場合は、

ProgressBar1.Value = 0
 ・・・作業・・・・

この作業がどんなコードなのかわからないので何ともいえませんが、

今回提示した例も検証していただいて
ご自分のコードと照らし合わせてみてください。

0 hits

【40804】ラベルの文字について tk 06/7/24(月) 14:30 質問
【40820】Re:ラベルの文字について ichinose 06/7/24(月) 18:34 発言
【40852】Re:ラベルの文字について hori 06/7/25(火) 10:56 質問
【40854】Re:ラベルの文字について tk 06/7/25(火) 11:28 質問
【40873】Re:ラベルの文字について tk 06/7/25(火) 16:25 質問
【40893】Re:ラベルの文字について ichinose 06/7/25(火) 19:54 発言
【40896】Re:ラベルの文字について 追伸 ichinose 06/7/25(火) 20:21 発言
【40899】Re:ラベルの文字についての追伸2 ichinose 06/7/25(火) 21:44 発言
【40911】ラベルの文字について tk 06/7/26(水) 8:14 質問
【40908】Re:ラベルの文字について hori 06/7/26(水) 1:04 お礼
【40912】ラベルの文字について tk 06/7/26(水) 8:16 質問
【40927】Re:ラベルの文字について tk 06/7/26(水) 13:41 お礼

40928 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free