投稿者 ザボン  (社会人) 投稿日時 2014/12/1 14:19:33

シート3に以下のプログラムを

Private DCB As DCBstructure
Private Settings As String

Sub Worksheet_Activate()
'↑シート3がアクティブ(選択状態)になると実行される

'シートを保護するが、マクロではセルの値変更可能になる
Sheet2.Protect UserInterfaceOnly:=True

'シート3を隠す
Worksheets("Sheet3").Visible = False

'受信データを書き込むシート2を選択する
Sheet2.Select

'セルを選択できない用にロックする
ActiveSheet.EnableSelection = xlUnlockedCells
' スクロール範囲を設定する
ActiveSheet.ScrollArea = "$A$1:$R$26"

Dim cto As COMMTIMEOUTS                       
Dim Last_Row As Long                          
Dim today, niti, getumatu, tuki As String     
Dim buf As String * 256                       
Dim deta1, deta2 As Variant                  
Dim i, j, k, o, nipo As Integer     
          
' COMポートを開く
hCom = CommOpen(Sheet1.Range("C3"))  'シート1のC3にCOMポート番号
Call InitializeComm

If hCom = INVALID_HANDLE_VALUE Then
    Call MsgBox("COMポートが開けません", vbOKOnly Or vbCritical)
    Call CommClose(hCom)  'COMポートを閉じる
End If

' タイムアウトを設定
cto.ReadTotalTimeoutConstant = 1000 'タイムアウト時間(ms)
Call SetCommTimeout(hCom, cto)  'Module1内のタイムアウト命令を呼び出す

'シート2の測定値を書き込む空白行はBの何行目かを探す
Last_Row = ActiveSheet.Cells(27, 2).End(xlUp).Row
j = Last_Row + 1


'23時のデータを受信するまで常にデータを受信する
Do While nipo <> 2300
    
    DoEvents      
    k = 2  'シート2の2列目から受信データを書き込む
    
    buf = ""
    deta1 = ""
    deta2 = ""
        
    'この部分を変更したいです。ループでずっと読み込むんじゃなくてbufにデータが入ったら読み込む様に
    Do While CommInput(hCom, buf, Len(buf)) = 0    ' 受信する(Module1内の受信命令を実行)
          DoEvents  
    Loop
      
    deta1 = Split(buf, vbCrLf)
    For o = 0 To UBound(deta1) - 1
            deta2 = Split(deta1(o), ",")

        For i = 0 To UBound(deta2)
             Sheet2.Cells(j, k) = deta2(i)
             k = k + 1
        Next i
    
    Next o
    
  nipo = Sheet2.Cells(j, 4)

    j = j + 1

Loop

    Call CommClose(hCom)  'Module1内のCOMポートを閉じる命令を実行

End Sub

Private Function InitializeComm() As Boolean          。
   Settings = Sheet1.Range("C4")        '9600,N,7,1" ”ボーレート,パリティーチェックなし,データ長,ストップビット
   If hCom > 0 Then
      BuildCommDCB Settings, DCB
      DCB.Flags = DCB.Flags Or 1         ' Binary Mode ON
      DCB.Flags = DCB.Flags Or &H1010    ' DTR and RTS Enable
      SetCommState hComm, DCB
      InitializeComm = True
   Else
      MsgBox "COMポートが開けません" , vbOKOnly + vbCritical + vbApplicationModal
      InitializeComm = False
   End If
End Function