| |
▼yhar さん：
こんばんは。
>そろそろ私の能力では限界に来ているようで、コードを整理して教えを請いたいと
>思います。
>
>現時点での問題は
>１．Myapp.Run "ura.xls!Module1.ECGetData" で ura.xlsのマクロを実行すると
> ura.xls が表示された状態で、omote.xls は、マクロの実行待ちの状態にな
> ってしまう。
>２．ura.xlsで取得したデータを別インスタンスで開いているomote.xlsのあるセル
> へ書き込む方法がわからない。
>の２点です。
もうちょっと簡単な例題しましょう！！
ブックを二つ用意します。
１のブック dsptime.xls
機能 ユーザーフォームに時間経過を表示する機能を持つ
２のブック setcell.xls
機能 setcell.xlsの最左端シートのＡ列に1から20000までの数値を書き込む
時間を計測し、セルＢ１に設定する
dsptime.xls
ユーザーフォーム（Userform1）を一つ用意してください。
このUserform1には、
Label1 開始時間の表示
Label2 現在の時間を表示
という二つのラベルを用意してください。
ふたつのラベルには、hh:mm:ss形式で時刻を表示しますので、それに
足りうる幅をラベルは有します。
コードです。
Thisworkbookのモジュール
'==================================================================
Sub set_proc()
Application.OnTime Now(), "thisworkbook.dspform"
End Sub
'==================================================================
Sub dspform()
UserForm1.Show
End Sub
'==================================================================
Sub unloadform()
' Userform1の消去
Unload UserForm1
End Sub
'==================================================================
Sub hideform()
' 時間表示を停止する
UserForm1.dsp = False
End Sub
'==================================================================
Sub set_tm(rng As Range)
' 開始から、停止までの時間を指定されたセルに設定する
rng.Value = UserForm1.時間
End Sub
Userform1のモジュールに
'===================================================================
Option Explicit
Public dsp As Boolean
Public 時間 As Date
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'===================================================================
Private Sub UserForm_Activate()
dsp = True
Label1.Caption = Format([now()], "hh:mm:ss")
Do While dsp = True
Label2.Caption = Format([now()], "hh:mm:ss")
DoEvents
Sleep 300
Loop
時間 = CDate(Label2.Caption) - CDate(Label1.Caption)
Me.Hide
End Sub
'===================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then
Cancel = True
End If
End Sub
setcell.xlsのコード
標準モジュールに
'=====================================================================
Sub main()
Dim g0 As Long
Dim ex As Application
Dim dbk As Excel.Workbook
Set ex = CreateObject("excel.application")
Set dbk = ex.Workbooks.Open(ThisWorkbook.Path & "\disptime.xls")
ex.Run dbk.Name & "!thisworkbook.set_proc"
ThisWorkbook.Activate
Worksheets(1).Activate
Range("a:a").ClearContents
For g0 = 1 To 20000
With Cells(g0, 1)
.Select
.Value = g0
End With
Next
Worksheets(1).Range("b1").NumberFormatLocal = "hh:mm:ss"
ex.Run dbk.Name & "!thisworkbook.hideform"
ex.Run dbk.Name & "!thisworkbook.set_tm", Worksheets(1).Range("b1")
ex.Run dbk.Name & "!thisworkbook.unloadform"
dbk.Close False
ex.Quit
End Sub
上記のブックを同じフォルダ上に保存した後、
setcell.xlsだけを開いて、mainを実行して動作とコードを確認してください。
Application.Run でそのまま目的のコードを実行させると
同期が取れてしまいます。
非同期に作動するように工夫することがポイントですよ！！
|
|
ichinose
- 07/12/17(月) 21:55 -
