| |
▼ichinose さん：
返事ありがとうございます。
UserForm1に
Private Sub CommandButton1_Click()
Call disp_open(Label1, "処理中しばらくお待ちください", 30)
Range("A1:AF84").Select
Call disp_proc
DoEvents
Range("AF84").Activate
Call disp_proc
DoEvents
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$84"
Call disp_proc
DoEvents
With ActiveSheet.PageSetup
End With
Call disp_proc
DoEvents
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$84"
With ActiveSheet.PageSetup
.PrintHeadings = False
Call disp_proc
DoEvents
.PrintGridlines = False
Call disp_proc
DoEvents
.PrintComments = xlPrintNoComments
Call disp_proc
DoEvents
.PrintQuality = 600
Call disp_proc
DoEvents
.CenterHorizontally = False
Call disp_proc
DoEvents
.CenterVertically = False
Call disp_proc
DoEvents
.Orientation = xlPortrait
Call disp_proc
DoEvents
.Draft = False
Call disp_proc
DoEvents
.PaperSize = xlPaperA4
Call disp_proc
DoEvents
.FirstPageNumber = xlAutomatic
Call disp_proc
DoEvents
.Order = xlDownThenOver
Call disp_proc
DoEvents
.BlackAndWhite = False
Call disp_proc
DoEvents
.PrintErrors = xlPrintErrorsDisplayed
Application.Goto Reference:="R17C4"
End With
Call disp_proc
DoEvents
Call disp_close
Label1.Caption = ""
Hide
End Sub
Private Sub CommandButton2_Click()
Hide
End Sub
Private Sub CommandButton3_Click()
Call disp_open(Label1, "処理中しばらくお待ちください", 30)
Range("A1:BL84").Select
Call disp_proc
DoEvents
Range("BL84").Activate
Call disp_proc
DoEvents
ActiveSheet.PageSetup.PrintArea = "$A$1:$BL$84"
Call disp_proc
DoEvents
With ActiveSheet.PageSetup
End With
Call disp_proc
DoEvents
ActiveSheet.PageSetup.PrintArea = "$A$1:$BL$84"
With ActiveSheet.PageSetup
Call disp_proc
DoEvents
.PrintHeadings = False
Call disp_proc
DoEvents
.PrintGridlines = False
Call disp_proc
DoEvents
.PrintComments = xlPrintNoComments
Call disp_proc
DoEvents
.PrintQuality = 600
Call disp_proc
DoEvents
.CenterHorizontally = False
Call disp_proc
DoEvents
.CenterVertically = False
Call disp_proc
DoEvents
.Orientation = xlLandscape
Call disp_proc
DoEvents
.Draft = False
Call disp_proc
DoEvents
.PaperSize = xlPaperA3
Call disp_proc
DoEvents
.FirstPageNumber = xlAutomatic
Call disp_proc
DoEvents
.Order = xlDownThenOver
Call disp_proc
DoEvents
.BlackAndWhite = False
Call disp_proc
DoEvents
.PrintErrors = xlPrintErrorsDisplayed
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R17C4"
End With
Call disp_proc
DoEvents
Call disp_close
Label1.Caption = ""
Hide
End Sub
標準モジュールに
'===========================================================
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private d_str As String
Private d_idx As Long
Private d_lbl As MSForms.Label
Private d_int As Long
Private d_len As Long
Private d_jdx As Long
'======================================================================
Sub disp_open(ByVal lbl As MSForms.Label, ByVal disp_str As String, Optional ByVal interval As Long = 100)
Dim wk As Double
Set d_lbl = lbl
d_str = disp_str & String(Len(disp_str), " ")
With d_lbl
wk = .ForeColor
.ForeColor = .BackColor
.TextAlign = fmTextAlignRight
.Caption = disp_str
.Font.Name = "ＭＳ ゴシック"
.Font.Size = 10
.AutoSize = True
DoEvents
.AutoSize = False
.Caption = ""
.ForeColor = wk
.Height = 20
End With
d_idx = 1
d_jdx = 1
d_int = interval
d_len = Len(disp_str)
End Sub
'===============================================================
Sub disp_proc()
Dim mystr As String
If d_jdx > d_len Then
d_idx = 1
d_lbl.Caption = ""
d_jdx = 1
End If
If d_idx > d_len Then
d_jdx = d_jdx + 1
d_idx = d_len
End If
mystr = Mid(d_str, d_jdx, d_idx)
d_lbl.Caption = mystr
d_idx = d_idx + 1
Sleep d_int
End Sub
'==================================================================
Sub disp_close()
d_str = ""
d_idx = 0
d_lbl.Caption = ""
Set d_lbl = Nothing
End Sub
このようにしています。
>>下記にてプログラムを実行すると矢印キー、Enterキーが動作不能に
>>なるのですがお解りになる方教授お願いします。
>>
>>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40893;id=excel
>
>この記述では、再現手順の記述になっていません。
>なっていなければ、投稿を見ても再現ができませんよね！！
>
>horiさんは、「矢印キー、Enterキーが動作不能になる」
>再現手順書を記述してみてください。
>その際この現象を確認したExcelのバージョンの記述もお願いします。
Excel2002＆2003両方で同じ現象があります。
>
>気になったのは、Commandbutton1をクリックして
>ファイル検索中にユーザーフォームの閉じるボタンをクリックして
>ユーザーフォームを閉じてしまった場合ですが・・・。
以上ですよろしくお願いします。
|
|
hori
- 06/9/19(火) 21:04 -
