| |
ご存知の方がいらっしゃいましたらご教授ください。
RS-232Cで接続されている測定機から測定データをPCに取り込む際に
測定機に付属されてきた、Excelマクロを使用してデータの取込みを行っているのですが
このマクロを実行中は他の操作が一切受け付けられません。
他のExcelブックを開く、別のシートに切り替えるetc...等
下記にマクロを記載いたしますので、マクロ実行中に他のExcelブックを開くなどの
操作ができるように改良できるようでしたら、ご教授願います。
以下マクロ
--------------------------------------------------------------------------
'
' Mini-Z Data Transfer Sample Program
'
' Version 1.0 (2006/12)
' Rigaku Industrial Corporation
'
Option Explicit
'
' Objects used in this program.
'
Public TheWorkbook As Workbook ' Workbook for data display
Public TheWorksheet As Worksheet ' Worksheet for data display
'
' Objects used in this module.
'
Private TheFormStop As FormStop ' Form to show stop button
Private SerialPortNumber As Integer ' Serial port number for the connection
Private OnlyAnalysisData As Boolean ' What data is displayed, all data or only analysis data
'
' Contents of the data sent from the Mini-Z X-ray fluorescence spectrometer
'
Type MiniZData
SampleName As String
TurretNumber As Integer
DataType As Integer
ElementName(0 To 1) As String
ChannelType(0 To 1) As String
AnalysisStatus As Integer
NumberOfRepeat As Integer
AnalysisDate As String
MeasPosition(0 To 1) As Double
ConditionNumber As Integer
Data1Status As Integer
Data1(0 To 5) As Double
Data2Status As Integer
Data2(0 To 5) As Double
End Type
'
' Start_Click -- Callback for the start button
'
Public Sub Start_Click()
On Error GoTo OnError
Call ReadSettings
Call OpenSerialPort(SerialPortNumber)
Call ShowFormStop
Call PrepareWorkbook
Call MainLoop
Call CloseSerialPort
End
OnError:
Call CloseSerialPort
If Not TheFormStop Is Nothing Then
TheFormStop.Hide
End If
Call ShowError
End
End Sub
'
' StopProgram -- Stops the program execution
'
Public Sub StopProgram()
End
End Sub
'
' ReadSettings -- Reads the settings made at the operation worksheet.
'
Private Sub ReadSettings()
SerialPortNumber = Worksheets("Operation").Range("ComPortSelection").Value
OnlyAnalysisData = (Worksheets("Operation").Range("DisplaySelection").Value = 1)
End Sub
'
' ShowFromStop -- Shows the FormStop
'
Private Sub ShowFormStop()
Set TheFormStop = New FormStop
Call TheFormStop.Show(vbModeless)
End Sub
'
' PrepareWorkbook -- Prepares a workbook to display the received result.
'
Private Sub PrepareWorkbook()
Set TheWorkbook = Workbooks.Add
Set TheWorksheet = TheWorkbook.Worksheets(1)
TheWorksheet.Activate
End Sub
'
' MainLoop -- Main loop of this program, read data from the connection and display.
'
Private Sub MainLoop()
Dim Number As Long
Number = 1
Do
DoEvents
#If LOOPBACKTEST Then
Call WriteSerialPort("SAMPLE7890 1 11SiAlPP000120061128101315 11 32.5 31.811.885711.885710.4000 128.968628.93861.244021.244021.05000 " & vbCrLf)
#End If
Dim ReceivedData As String
ReceivedData = ReadSerialPort()
Dim DecodedData As MiniZData
Call DecodeData(ReceivedData, DecodedData)
Call DisplayData(OnlyAnalysisData, Number, DecodedData, ReceivedData)
Number = Number + 1
Loop
End Sub
'
' ShowError -- Shows the error message.
'
Private Sub ShowError()
If Err.Number = 0 Then Return
Dim message As String
message = "Number: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Call MsgBox(message, vbExclamation, "Mini-Z Data Transfer Sample")
End Sub
'
' Serial Port handling by using EasyComm
'
' OpenSerialPort -- Opens the specified serial port and set it up.
'
Private Sub OpenSerialPort(comNumber As Integer)
#If NOHARDWAREDEMO Then
#Else
' Raise an error when something is wrong.
ec.Xerror = 1
' Set the serial port number.
ec.COMn = comNumber
' Set up the connection line: 9600 bps, non-parity、data bits 8、stop bit 1.
ec.Setting = "9600,n,8,1"
' RTS/CTS hand shake
ec.HandShaking = ec.HANDSHAKEs.RTSCTS
' Set up line delimiter.
ec.Delimiter = ec.DELIMs.ETX
#End If
End Sub
'
' WriteSerialPort -- Attaches delimiter then writes data to the serial connection.
'
Private Sub WriteSerialPort(data As String)
#If NOHARDWAREDEMO Then
#Else
ec.AsciiLine = data
#End If
End Sub
'
' ReadSerialPort -- Reads data from the serial connection until delimiter.
'
Private Function ReadSerialPort() As String
#If NOHARDWAREDEMO Then
Call Sleep(500)
ReadSerialPort = "SAMPLE7890 1 11SiAlPP000120061128101315 11 32.5 31.811.885711.885710.4000 128.968628.93861.244021.244021.05000 " & vbCrLf
#Else
ReadSerialPort = ec.AsciiLine
#End If
End Function
'
' CloseSerialPort -- Closes the serial connection.
'
Public Sub CloseSerialPort()
#If NOHARDWAREDEMO Then
#Else
ec.COMn = -1
#End If
End Sub
---------------------------------------------------------------------------
|
|
勝山
- 12/6/28(木) 13:39 -
