Sub Macro10()
'
'　マクロ名は適当につけてください
' Macro10 Macro
' マクロ記録日 : 2008/4/3  ユーザー名 : nic
' ｅｘｃｅｌからRS232Cを通してデータを集めるプログラム
'
' 「easycomm」を利用させていただいております
'　このプログラムは「easycomm」がインストールされている
'　前提で動きます
'  http://www.activecell.jp/ec/index.htm
'
'  「Yoshi, snyc」さんのｗａｉｔ関数を利用させていただいております。
'  http://snyc.s28.xrea.com/
'
'

'
 Dim str As String
 Dim i As Integer
 Dim count As Integer
 Dim waittime As Long
 
    ec.COMn = 1                   ' COM1を使用します
    ec.Setting = "9600,n,8,1"     ' 通信条件を設定します
'    ec.HandShaking = ec.HANDSHAKEs.RTSCTS   ' ハンドシェーク方式を設定します．
    ec.HandShaking = ec.HANDSHAKEs.No   ' ハンドシェーク方式を設定します．
'    ec.Delimiter = ec.DELIMs.CrLf   ' デリミタを設定します(CR+LF)
    ec.Delimiter = ec.DELIMs.CR   ' デリミタを設定します (CR)

  Range("j2") = "" 'セルＪ２をクリアー　なくても良い
  Range("j3") = "" 'セルＪ３をクリアー（作業開始時に終了のendを消す）
   
'  Range("k2").Select
  waittime = Range("k2")   'セルＫ２のサンプリング間隔を読み込む
  count = Range("L2")      'セルＬ２のサンプリング回数を読み込む
  
   
   i = 2
   While i <= count + 1
      
'   For i = 2 To 11
     str = CStr(i) ' str = "I"   'ｓｔｒに数値「Ｉ」を文字として代入
     
    
    Range("J2").Select                     'セルＪ２を選択
    ActiveCell.FormulaR1C1 = "=NOW()"      '今の日付時刻を入れる

    Range("J2").Select                     'セルＪ２を選択
    Selection.Copy                         'コピーする
    Range("A" + str).Select                '日付を入れるセルを選択
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False          '値貼り付け
    Application.CutCopyMode = False
    Selection.NumberFormatLocal = "yyyy/m/d"    '表示を2008/4/3形式にする

    Range("J2").Select
    Selection.Copy
    Range("B" + str).Select                     '時刻を入れるセルを選択
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False               '値貼り付け
    Application.CutCopyMode = False
    Selection.NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"  '表示を13:25:15形式にする

'    ec.AsciiLine = "F2,PR2,M1,E"  ' 測定開始
    ec.AsciiLine = "0"  ' 測定開始 CH0
    Range("C" + str) = ec.AsciiLine  ' 測定データの受信と書き込み
    ec.AsciiLine = "1"  ' 測定開始 CH1
    Range("D" + str) = ec.AsciiLine  ' 測定データの受信と書き込み
    ec.AsciiLine = "2"  ' 測定開始 CH2
    Range("E" + str) = ec.AsciiLine  ' 測定データの受信と書き込み
    ec.AsciiLine = "3"  ' 測定開始 CH3
    Range("F" + str) = ec.AsciiLine  ' 測定データの受信と書き込み
    
    Call Wait(waittime) ' wait milisecond

    i = i + 1

   Wend
'   Next
    ec.COMn = -1        ' ポートを閉じます
  
'  Range("J3").Select
  Range("j3") = "end"    '作業が終了したことを表示
  

End Sub


Private Sub Wait(ByVal waittime As Long)
    Dim starttime As Long

    starttime = timeGetTime()

    Do While timeGetTime() - starttime < waittime
        DoEvents
    Loop
End Sub