'エラー処理未掲載
'VBAではエラーは出ないが動作せず
' ＧＭカウンタの検索
' ＧＭカウンタのデバイス名を返します。デバイスが見つからない場合は""を返します。
 Public Declare Function FindUSB Lib "gmlib.dll" _
     Alias "_FindUSB@4" (ByRef index As Long) As String
  
' カウント値・時間の取得
' カウント値と時間を取得します。このカウント値は液晶にされるものと同じです。
' 時間は液晶に表示されている時間ですが、単位は秒で返します。例）10分は600という数値を返します。
' 一番目の引き数はFundUSBで返したものを渡します。
 Public Declare Function GetCountTime Lib "gmlib.dll" _
     Alias "_GetCountTime@12" (ByVal dev As String, ByRef count As Long, ByRef time As Long) As Long
  
' カウント値・時間のクリア
' ＧＭカウンタのカウント値と時間を０にします。
' クリアと同時にＧＭキットの液晶表示も０になります
' 一番目の引き数はFundUSBで返したものを渡します。
 Public Declare Function Clear Lib "gmlib.dll" _
     Alias "_Clear@4" (ByVal dev As String) As Long

'  バージョン取得
' ＧＭカウンタの内部バージョンを返します。バージョンはYY/MM/DDの日付形式になっています。
' 一番目の引き数はFundUSBで返したものを渡します。
 Public Declare Function GetVers Lib "gmlib.dll" _
    Alias "_GetVers@4" (ByVal dev As String) As String

Dim device As String, av10m As Variant, diam10m As Variant

Private Sub Form_Load()
   Call sChartViewSet   'グラフの表示設定
End Sub

Private Sub Command1_Click()
    Dim idx As Long
    av10m = txtAV.Text          '10分平均初期値をTXTボックスより取得
    diam10m = txtDiam.Text      '10分上昇率初期値をTXTボックスより取得
    If Not IsNumeric(av10m) Or Not IsNumeric(diam10m) Then
        MsgBox "基準値となる数値を入力してください"
        Exit Sub
    Else
        av10m = CSng(av10m)     '数値化・単精度浮動小数点型
        diam10m = CSng(diam10m)	'数値化・単精度浮動小数点型
    End If
    
    count_1 = 0                 '初期化
    LbCPM10m.Caption = av10m    '初期値を表示
    device = FindUSB(idx)
    If device = "" Then
        MsgBox "GMｶｳﾝﾀが検出できませんでした"
        Exit Sub
    End If
    Timer1.Enabled = True
    Timer2.Enabled = True
    If CheckAlrt.Value = 1 Then   '警告メール機能の有効無効
        Timer3.Enabled = True
    Else
        Timer3.Enabled = False
    End If
    Command1.Enabled = False
    Command2.Enabled = True
    Command3.Enabled = True
End Sub

Private Sub Command2_Click()
    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command1.Enabled = True
End Sub

Private Sub Command3_Click()
    Call Clear(device)
End Sub

Private Sub Form_Load()
   Call sChartViewSetAV  'グラフの表示設定・平均表示
   opt1H.Value = True
   optLineAv.Value = True
End Sub

Private Sub opt1H_Click()
   txt1line.Text = "-20m"
   txt2line.Text = "-40m"
   txt3line.Text = "-60m"
   scaleTime = 59
End Sub

Private Sub opt3H_Click()
   txt1line.Text = "-1h"
   txt2line.Text = "-2h"
   txt3line.Text = "-3h"
   scaleTime = 179
End Sub

Private Sub optLineAv_Click()
   Call sChartViewSetAV
End Sub

Private Sub optLineTrend_Click()
   Call sChartViewSetTrend
End Sub

Private Sub Excel(xlsSheet As Object)
Const xlUp = -4162 'FFFFEFBE
If xlsSheet.Range("A1").Value = "" Then 'A1が空白なら
xlsSheet.Range("A1") = Format(time, "hh:mm:ss") 'A1に表示
Else '違ったら
xlsSheet.Range("A" & xlsSheet.Rows.count).End(xlUp).Offset(1, 0) = Format(time, "hh:mm:ss") 'A列の最終行の1つ下のセルに表示
End If
End Sub

Private Sub Command6_Click()
Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSheet As Object
Set xlsApp = GetObject(, "Excel.Application")
Set xlsBook = xlsApp.ActiveWorkbook
Set xlsSheet = xlsBook.ActiveSheet 'ActiveSheet取得
Const xlUp = -4162 'FFFFEFBE
With xlsSheet.Range("B" & xlsSheet.Rows.count).End(xlUp).Offset(1, 0) 'B列の最終行の1つ下のセル
.Value = Format(time, "hh:mm:ss")
.Offset(0, 1).Value = Label4.Caption 'さらに右となりのセル(C列)
End With
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
End Sub

Private Sub dWrite()
Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSheet As Object
Set xlsApp = GetObject(, "Excel.Application")
Set xlsBook = xlsApp.ActiveWorkbook
Set xlsSheet = xlsBook.Worksheets(1)    'ActiveSheet 'ActiveSheet取得
Const xlUp = -4162 'FFFFEFBE
With xlsSheet.Range("C" & xlsSheet.Rows.count).End(xlUp).Offset(1, 0) 'C列の最終行の1つ下のセル
    .Value = Format(Now(), "General Date")
    .Offset(0, 1).Value = LbCPM.Caption 'さらに右となりのセル(D列)
    .Offset(0, 2).Value = LbmSV.Caption 'さらに右となりのセル(E列)
    .Offset(0, -2).Value = 0            '左2セルのに晴の0を入力
End With
    xlsSheet.Range("F" & xlsSheet.Rows.count).End(xlUp).Resize(1, 4).Copy _
    Destination:=xlsSheet.Range("F" & xlsSheet.Rows.count).End(xlUp).Offset(1, 0)
    xlsSheet.Range("B" & xlsSheet.Rows.count).End(xlUp).Copy _
    Destination:=xlsSheet.Range("B" & xlsSheet.Rows.count).End(xlUp).Offset(1, 0)
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
End Sub

Private Sub Timer1_Timer()
    Dim count As Long, time As Long, dd As Long, HH As Long, mm As Long, ss As Long
    lbDate.Caption = Format$(Now, "hh:mm:ss")
    txtNow.Text = Format$(Now, "hh:mm")
    If opt1H.Value = True Then
        txt1line.Text = Format$(DateAdd("n", -20, Now), "hh:mm")    '20分前表示
        txt2line.Text = Format$(DateAdd("n", -40, Now), "hh:mm")    '40分前
        txt3line.Text = Format$(DateAdd("n", -60, Now), "hh:mm")    '60分前
    Else
        txt1line.Text = Format$(DateAdd("h", -1, Now), "hh:mm")    '1時間前表示
        txt2line.Text = Format$(DateAdd("h", -2, Now), "hh:mm")    '2時間前
        txt3line.Text = Format$(DateAdd("h", -3, Now), "hh:mm")    '3時間前
    End If
    timeplot = Format$(Now, "hh:mm")                           'グラフ用
    Call GetCountTime(device, count, time)
    txtCount.Text = count
    If time = 0 Then
        txtCPMtotal.Text = 0
    Else
        dd = Int(time / 86400)  '日数
        HH = Int((time - dd * 86400) / 3600)    '時間
        mm = Int((time - dd * 86400 - HH * 3600) / 60)  '分数
        ss = Int(time - dd * 86400 - HH * 3600 - mm * 60)   '秒数
        txtTime.Text = dd & "日" & HH & "時間" & mm & "分" & ss & "秒"
        txtCPMtotal.Text = Round(count / (time / 60), 2)    '小数点2位で丸め　過去平均
    End If
End Sub

Private Sub Timer2_Timer()
    Static count_1 As Long  'Staticにしないとデータの保持ができない
    Static count_m As Long
    Call GetCountTime(device, count_m, time)
    If count_1 = 0 Then 'count_1=0の時Label4に生データが入力されるため
        Label4.Caption = "計測中"
    Else
        txtCPM.Text = (count_m - count_1)               '過去1分間での平均　毎分表示
        txtmSV.Text = (count_m - count_1) * 0.07884     '1cpm=0.07884mSv(Cs137)
        cntplot = (count_m - count_1)                   'グラフ用
        'Call dWrite 'データ書込みプロシージャ呼び出し
        If scaleTime = 59 Then
            Call cpmplot
        Else
            Call cpmplot3
        End If
    End If
    count_1 = count_m
End Sub

Private Sub Timer3_Timer()
    '10分毎 interval 60000msec以上不可
    Static count_1m As Long
    Static count_10m As Long
    Static intMinutes As Long

    If LbCPM.Caption = "計測中" Or LbCPM.Caption = "" Then
    Else
        intMinuts = intMinuts + 1
        If intMinuts = 1 Then
            Call GetCountTime(device, count_1m, time)  '初回値を取得
            count_1m = count_1m
        ElseIf intMinuts > 1 And intMinuts < 10 Then
        ElseIf intMinuts = 11 Then                      '10分後
            Call GetCountTime(device, count_10m, time)  '現在カウントを入力
            If av10m <> 0 Then
                '比率が設定規準以上ならメール送信
                If (((count_10m - count_1m) / 1) / av10m) > diam10m Then
                    Call AlertMail
                End If
            Else
            End If
            av10m = (count_10m - count_1m) / 10             '基準値の更新
            diam10m = ((count_10m - count_1m) / 1) / av10m  '基準値の更新
            LbCPM10m.Caption = (count_10m - count_1m) / 10  '毎10分表示
            intMinuts = 0                                   'リセット
        End If
    End If
End Sub

Private Sub AlertMail()
'警告メールを送信
'OS・環境により使い分け
'Set oMsg = CreateObject("CDO.Message")
'oMsg.From = "mailsender@example.co.jp"
'oMsg.To = "test@mail.com;test2@mail.com"    'セミコロンで複数
'oMsg.Subject = "Radiation Alert"
'oMsg.TextBody = "" & vbCrLf & Now
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "test.mail.com"
'oMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'oMsg.Configuration.Fields.Update
'oMsg.Send

'以下もOK
Set objMesseage = New CDO.Message
Set objConfiguration = New CDO.Configuration
Set objFields = objConfiguration.Fields
With objFields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServer) = "test.mail.com"
    .Update
End With
With objMesseage
    Set .Configuration = objConfiguration
    .To = "test@mail.com;test2@mail.com"	'複数指定はセミコロンで追加
    .From = "teat@mail.com"
    .Subject = "****"
    .TextBody = "****"
    .Send
End With
End Sub

Private Sub sChartViewSet()
'グラフの表示設定
'-------------------　グラフの種類を設定　----------------------
   '設定しなければ、VtChChartType2dBar となる
MSChart1.ChartType = VtChChartType2dLine       'デフォルトのグラフタイプ（2D）
'グラフの種類は下記より選択
'                  VtChChartType3dBar           '3 次元バー
'                  VtChChartType2dBar           '2 次元バー
'                  VtChChartType3dLine          '3 次元線
'                  VtChChartType2dLine          '2 次元線
'                  VtChChartType3dArea          '3 次元面
'                  VtChChartType2dArea          '2 次元面
'                  VtChChartType3dStep          '3 次元階段
'                  VtChChartType2dStep          '2 次元階段
'                  VtChChartType3dCombination   '3 次元組み合わせ
'                  VtChChartType2dCombination   '2 次元組み合わせ
'                  VtChChartType2dPie           '2 次元パイ
'                  VtChChartType2dXY            '2 次元 XY
'---------------------------------------------------------------
'   With MSChart1.Plot.Axis(VtChAxisIdY).ValueScale
'      .Auto = False                          '自動設定を解除
'      .Maximum = 120                         '最大値
'      .Minimum = 0                           '最小値
'      .MajorDivision = 12                    '目盛り線の数（等分）10点毎
'      .MinorDivision = 2                     '補助目盛り線等分　　 5点毎
'   End With
'----------------　X 軸のラベルの間隔、補助メモリの表示単位の設定　-------------------
   '実行結果の図では、解り易いように緑色の太い線で表示しております。
'   With MSChart1.Plot.Axis(VtChAxisIdX).CategoryScale
'      .Auto = False
'      'ラベルの表示間隔　２＝飛び飛びに氏名を表示
'      .DivisionsPerLabel = 1  '１名毎
'      'ラベルの区切り　　　２＝２名一緒に一枠に表示
'      .DivisionsPerTick = 2   '2名毎に区切り線を表示
'   End With
   '区切りを設定しない場合
'   MSChart1.Plot.Axis(VtChAxisIdX).Tick.Style = VtChAxisTickStyleNone
   
   'X 軸のラベルの図表の間隔線(桃色の縦線の部分)
'   With MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid
'      .MajorPen.Style = VtPenStyleDitted
'      .MajorPen.Width = 60
'      .MajorPen.VtColor.Set 255, 0, 255
'   End With
'　Y軸の目盛り区分を示すマーカーのように長さや表示スタイルは
'　折れ線グラフの時のみ有効(別途、No.12 の表示例参照）

End Sub

Private Sub cpmplot()
    'チャート描画
    Static i As Integer
    Static Dat(0 To 59, 0 To 1) As Variant
    For i = 1 To 58
        Dat(i, 0) = Dat(i + 1, 0)   '全排列データを一括で左方に1列移動
    Next i
    Dat(59, 0) = cntplot            'new dataは右端に
    MSChart1.ChartData = Dat()      'グラフ表示
End Sub

Private Sub cpmplot3()
    Static i As Integer
    Static Dat(0 To 179, 0 To 1) As Variant
    For i = 1 To 178
        Dat(i, 0) = Dat(i + 1, 0)
    Next i
    Dat(179, 0) = cntplot
    MSChart1.ChartData = Dat()      'グラフに表示する配列データを設定する
End Sub

Private Sub sChartViewSetTrend()
'トレンド線表示
    MSChart1.ChartType = VtChChartType2dLine       'デフォルトのグラフタイプ（2D）
        With MSChart1.Plot.SeriesCollection(1).StatLine
        .VtColor.Set 0, 255, 0
            .Flag = VtChStatsRegression
            .Style(VtChStatsRegression) = VtPenStyleDitted
        .Width = 1
        End With
End Sub

以下VBA
--------------------------------
Private doTime
Sub fExp()
    Call LastUpdate1
    Call ExportPng  'Select移動を減らすためグラフ単位で
    Call LastUpdate2
    Call ExportPngMobile
    Call LastUpdate3
    Call ExportPng2
    Call ftp    'ffftp実行
    Sheets("radiation").Select
End Sub

Sub itvTime()
'最初に実行
doTime = Now + TimeValue("00:05:00")'5分
Application.OnTime doTime, "fSave"
End Sub

Sub fSave()
Call fExp   'プロシージャー呼出し
doTime = Now + TimeValue("00:05:00")'5分
Application.OnTime doTime, "fSave"
End Sub

Sub rst()
If MsgBox("中止しますか？", vbYesNo) = vbYes Then
'プロシージャーキャンセル
Application.OnTime doTime, "fSave", , False
End If
End Sub

Sub ftp()
'ffftp
'-s または --set        ＝ 接続するホストの設定名を指定する
'-m または --mirror     ＝ 接続後ミラーリングアップロードを行う
'-d または --mirrordown ＝ 接続後ミラーリングダウンロードを行う
'-f または --force      ＝ ミラーリング開始の確認をしない
'-q または --quit       ＝ ミラーリング終了後、FFFTPを閉じる
Shell ("C:\*****\ffftp\FFFTP.exe -z ******** --set taki --mirror --force --quit"), vbMinimizedNoFocus
End Sub

Sub LastUpdate1()
    'グラフにアップデート日時を入力
    Sheets("Graph1").Select
    ActiveChart.Shapes.Range(Array("TextBox 1")).TextFrame2.TextRange.Characters.Text = _
    "Last Update" & Chr(13) & Format(Now(), "Short Date")
    ActiveChart.Shapes.Range(Array("TextBox 2")).TextFrame2.TextRange.Characters.Text = _
    Format(Now(), "Long Time")
End Sub

Sub LastUpdate2()
    Sheets("Graph2").Select
    ActiveChart.ChartTitle.Text = "Last Update " & Format(Now(), "Long Time")
End Sub

Sub LastUpdate3()
    Sheets("Graph3").Select
    ActiveChart.Shapes.Range(Array("TextBox 1")).TextFrame2.TextRange.Characters.Text = _
    "Last Update" & Chr(13) & Format(Now(), "Short Date")
    ActiveChart.Shapes.Range(Array("TextBox 2")).TextFrame2.TextRange.Characters.Text = _
    Format(Now(), "Long Time")
End Sub

Sub ExportPng()
    'グラフをPNG形式で出力
    Sheets("Graph1").Select
    ActiveChart.Export ("Z:\*****.png")
End Sub
Sub ExportPngMobile()
    'グラフをPNG形式で出力
    Sheets("Graph2").Select
    ActiveChart.Export ("Z:\****1.png")
End Sub

Sub ExportPng2()
    Sheets("Graph3").Select
    ActiveChart.Export ("Z:\****2.png")
End Sub