| |
そろそろ私の能力では限界に来ているようで、コードを整理して教えを請いたいと
思います。
現時点での問題は
１．Myapp.Run "ura.xls!Module1.ECGetData" で ura.xlsのマクロを実行すると
ura.xls が表示された状態で、omote.xls は、マクロの実行待ちの状態にな
ってしまう。
２．ura.xlsで取得したデータを別インスタンスで開いているomote.xlsのあるセル
へ書き込む方法がわからない。
の２点です。
２つのファイルをあらかじめ別インスタンスで開いておいて、それぞれのマクロを
ビジュアルベーシックエディタから起動すると思惑通りに動作します。この状態が
作れれば、あとは上記の２が解決すれば良いということになります。
omote.xlsには、以下のコードが書いてあり、シート上には「残時間」のカウント
ダウン値と現在時刻（秒単位表示）が表示されています。
表示画面のボタンを押すとblnStopがTrueとなりループから抜けます。
===============================================================
Public blnStop As Boolean
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Const SND_ASYNC = &H1
Sub Tact()
Dim Start, TactTime, Finish
Dim ZanJikan As Integer
Dim Dekidaka As Integer
Dim MotoSt As Worksheet: Set MotoSt = Worksheets("sheet1")
'Excelの別のインスタンスで「ura.xls」を起動してカウンタのデータを取り込む
On Error Resume Next
Dim Myapp As Object
Set Myapp = CreateObject("excel.Application")
With Myapp
.Visible = True
.Workbooks.Open "C:\Documents and Settings\hoge\デスクトップ\ura.xls"
End With
On Error GoTo 0
TactTime = MotoSt.Range("A2").Value '条件設定シートからタクトタイムを読み込む
ZanJikan = MotoSt.Range("A2").Value '残時間にタクトタイムをセットする
With Worksheets("表示画面")
.Select
.ScrollArea = "A1:A1" '表示画面に移動して画面をスクロール出来ないようにする
End With
'以下は表示画面をフルスクリーンにして全てのメニューバーを見えなくする
On Error Resume Next
With Application
.DisplayFullScreen = True
.CommandBars("Full Screen").Visible = False
.CommandBars("Worksheet Menu Bar").Enabled = False
End With
On Error GoTo 0
Worksheets("表示画面").Range("C2") = "" 'カーソルを見えないところに隠す
On Error Resume Next
Myapp.Run "ura.xls!Module1.ECGetData" 'ura.xlsのマクロを実行する
On Error GoTo 0
blnStop = False
Do While Not blnStop '停止ボタンがクリックされるまで繰り返す
Start = Timer '現在の時刻を保存する
Do While Timer < Start + 1 'タイマー（現在時刻）が１秒経過するまで制御をＯＳに渡す
DoEvents
Loop
ZanJikan = ZanJikan - 1 '残時間を１秒毎にカウントダウンする。
MotoSt.Range("B2") = ZanJikan '残時間をシートに書き込む
If ZanJikan <= 0 Then 'タクト残り時間が０になったら音で知らせる
Call PlaySound("c:\ringin.wav", 0, SND_ASYNC) 'ここで音声ファイルを指定する！！！
ZanJikan = TactTime 'タクト残り時間をタクトタイムに再設定する
End If
Loop
On Error Resume Next
Myapp.Save
Myapp.Quit
On Error GoTo 0
End Sub
=============================================================
ura.xlsには下記のコードを記述して制御機器からのデータを取り込んでいます。
Sub ECGetData()
Dim MotoSt As Worksheet: Set MotoSt = Worksheets("sheet1")
はじめ:
Start = Timer '現在の時刻を保存する
Do While Timer < Start + 3 'タイマー（現在時刻）が3秒経過するまで制御をＯＳに渡す
DoEvents
Loop
★ここからポートを開いて実際に通信するルーチン★
'データを取得してアクティブセルに書き込みます．
MotoSt.Range("B8") = resps '受信データをセルＢ８に書き込み。シート上の関数で10進に変換してＢ６へ
★ここで通信ポートを閉じる★
GoTo はじめ
End Sub
===========================================================
|
|
yhar
- 07/12/17(月) 17:22 -
