バランスWiiボードとPCで重心動揺計を作る ６

Excelでグラフにする　４

前回の続きです。


'グラフ作成
    Range("B4:C20").Select                                     'B4からC20の範囲を選択
    Charts.Add                                                 'グラフを挿入する
    ActiveChart.ChartType = xlXYScatterSmooth                   'グラフタイプは平滑線付き散布図・・・①
    ActiveChart.SetSourceData Source:=Sheets("作業用").Range("D2:E7000"), PlotBy:= _
        xlColumns                                                                     'データは作業用シートのD2からE7000
    ActiveChart.Location Where:=xlLocationAsObject, Name:="作業用"
    ActiveChart.SeriesCollection(1).Name = "重心軌跡"
     With ActiveSheet.ChartObjects("グラフ 1")                          '現在のシートの「グラフ1」は
        .Top = Range("G18").Top                                         '上端をG18セルに配置
        .Left = Range("G18").Left                                       '左端をG18セルに配置
                                             
    End With
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
1段目の
Range("B4:C20").Select                                     'B4からC20の範囲を選択
はこの辺をグラフにするよ、ということ。

①は平滑線なので各点を直線で結びたいときは「xlXYScatterSmooth」を「xlXYScatterLines」に変更します。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    ActiveChart.Axes(xlValue).Select                            'アクティブグラフを選択
    With ActiveChart.Axes(xlValue)                              'グラフX軸について
        .MinimumScale = -20                                     '最少値を-20Cm・・・②
        .MaximumScale = 20                                      '最大値を20Cm・・・②
        .MinorUnitIsAuto = True                                 '最少目盛は自動
        .MajorUnit = 5                                          '最大目盛を5Cm
        .Crosses = xlAutomatic                                  '交点は自動
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    
    With ActiveChart.Axes(xlCategory)                           'グラフY軸について
        .MinimumScale = -20                                     '最少値を-20Cm・・・③
        .MaximumScale = 20                                      '最大値を20Cm・・・③
        .MinorUnitIsAuto = True                                 '最少目盛は自動
        .MajorUnit = 5                                          '最大目盛を5Cm
    End With
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
②はX軸の最小大値設定で、あまり動揺のない人が対象なら、20cmから減らします。
逆に動作時の動揺を図るためならもっと大きくすることもできます。もちろんWiiボードのサイズ以下ですよ。
③はY軸で同様です。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    '矩形グラフ
    ActiveChart.SeriesCollection.NewSeries.MarkerStyle = xlMarkerStyleNone     'アクティブグラフに新規グラフを追加
    ActiveChart.SeriesCollection(2).XValues = "='作業用'!$K$12:$K16"            'X値は作業用シートK12からK16
    ActiveChart.SeriesCollection(2).Values = "='作業用'!$L$12:$L$16"            'Y値は作業用シートL12からL16
    ActiveChart.SeriesCollection(2).Points(2).Select                           '新規グラフを選択
    ActiveChart.SeriesCollection(2).ChartType = xlXYScatterLinesNoMarkers      '折れ線グラフでマーカーなし
    ActiveChart.SeriesCollection(2).Name = "矩形"                              '系列名を「矩形」
   －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
矩形グラフの様式です。
線の色の変更の仕方をどうすればいいかわかりません。
誰か教えてください。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
    '中心点ドット
    ActiveChart.SeriesCollection.NewSeries.MarkerStyle = xlMarkerStyleDot     'アクティブグラフに新規グラフを追加
    ActiveChart.SeriesCollection(3).XValues = "='作業用'!$H$12"                'X値は作業用シートH12
    ActiveChart.SeriesCollection(3).Values = "='作業用'!$I$12"                 'Y値は作業用シートI12
    ActiveChart.SeriesCollection(3).Name = "中心点"                           '系列名を「中心点」
    
    With Range("G13:O30")
        ActiveSheet.ChartObjects("グラフ 1").Width = .Width
        ActiveSheet.ChartObjects("グラフ 1").Height = .Height
    End With
    
－－－－－－－－－－－－－－－－－－－－－－－－－－
中心点のグラフ表示です。
同じくマーカーの色の変え方もわかりません。
－－－－－－－－－－－－－－－－－－－－－－－－－－  
    ActiveChart.HasTitle = True                                 'アクティブグラフのタイトル
    ActiveChart.ChartTitle.Text = "重心動揺計測　単位（cm）"    '「重心動揺計測　単位（cm）」を入力
    ActiveChart.ChartTitle.Font.Size = 16                       'フォントを16ポイント
－－－－－－－－－－－－－－－－－－－－－－－－
グラフのタイトルです。
"　"の間の字を変更できます。
－－－－－－－－－－－－－－－－－－－－－－－－  
    'プレビューボタンを作る
    ActiveSheet.Buttons.Add(536.25, 6, 42.75, 14.25).Select
    Selection.OnAction = "プレビュー"
    ActiveSheet.Shapes("Button 1").Select
    Selection.Characters.Text = "プレビュー"
    With Selection.Characters(Start:=1, Length:=5).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone

    End With
    Selection.ShapeRange.ScaleWidth 1.86, msoFalse, msoScaleFromTopLeft
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
プレビューボタンを貼り付けました。
印刷では非表示になります。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
      
    'シート名変更
        Worksheets("作業用").Name = "重心動揺" & Format(Time, "hhnn")
    
        MsgBox "処理が完了しました。", vbOKOnly, "完了"
        Worksheets(1).Select
End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
一旦「作業用」というシートを作りましたが、次に同じ「作業用」という名前のシートが作れないのと、数件あるとどれが誰だかわからなくなるので、時間をつけました。
時間は処理した時間○時○分です。
処理が終わるとメッセージが出ます。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub プレビュー()
    ActiveSheet.PageSetup.RightFooter = "Powerd by KITA Ver1.00"
    Range("G1:O36").PrintPreview                                'G1からO40セルの範囲をプレビュー表示

End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
プレビューボタンを押したときに実行するマクロです。
Excelってページが縦に進んでいくので、7000ケタもあると範囲を出すのがとんでもなく大変なので。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

と、これでコードの解説は終わりました。
うーん、ずいぶん長い時間（3ヶ月）かかって（とりあえず）できた、と達成感。

最後に
評価ツールはツールであって、そこから得られたデータを分析して、治療に結び付けてナンボだと思います。データを取ることが目標にならないようにしてくださいね。

私はPT歴20年超ですが、臨床実習指導もしたことないし、そもそもなりたくてなった職業ではないので仕事に対する温度は低いです。（仕事はまじめにやってますよ！）
でも、このマクロがPTだけでなく他の方のお役に立てば、私の役目は果たしたかなと思います。

それでは、これで「バランスWiiボードとPCで重心動揺計を作る」シリーズは終了します。

バランスWiiボードとPCで重心動揺計を作る ５

Excelでグラフにする

今回すること

３　マクロを実行してデータ操作ができるようにする。

やる気マンマンの方はもう試したかもしれませんが、今回はデータを操作できるようにします。
－－－－－に囲まれたところで解説します。
赤字は解説ポイントです。実際のコードにはありませんし、この部分のコードをコピペすると動かないかも。
前回の　「バランスWiiボードとPCで重心動揺計を作る　４」　をコピペしてください。
コード後方の緑字はそのコードのイミです。

Sub 空白セル()
    Worksheets("sheet0").Select
    Range("H1").Formula = "=countIf((A1:B7000),""*"")"
    If Range("H1") > 0 Then MsgBox "文字型セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "文字型セル"
    
    Worksheets("sheet0").Range("A1:B7000").Select
    Dim Rng As Range
    Set Rng = Selection
    On Error GoTo errhandler
    Selection.SpecialCells(xlCellTypeBlanks).Select
    MsgBox "空白セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "空白セル"
    Set Rng = Nothing
    Exit Sub
errhandler:
    MsgBox "文字型セル、空白セルはありませんでした。処理を続けます。", vbOKOnly, "セル内容"
    If vbOK Then Call 作業シート
End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub空白セル（）について（ココはコメントなし）
sheet0のA1からB7000の範囲に文字、空白があればグラフ化できないので、
調べて大丈夫なら次のマクロを続行します。
sheet0のH1セルに計算結果を出力しますので、そのセルに入力してあったものは置換されます。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub 作業シート()
    
    '作業用というシートを作る
    ActiveWorkbook.Sheets.Add.Name = "作業用"
   
    Range("g1").Value = "重心動揺計測"        'G1セルにタイトルを入力
    With Range("G1").Font                     'G1セルのフォントについて
        .Name = "MS明朝"                      'MS明朝体
        .Bold = True                          '太字
        .Color = vbBlue                       '青字
        .FontStyle = "斜体"                   '斜体
        .OutlineFont = True                   'アウトラインフォント
        .Size = 22                            '22ポイント
    End With
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub作業シート（）について
新しいワークシート「作業シート」を追加してタイトルをつけます。
「重心動揺計測」というタイトルを変更するなら、黒字のコードの
"重心動揺計測"を"変更したもの"　に変えればいいです。「"」で挟むのを忘れずに。
同じようにサイズを変えたければ、黒字の「22」を変更します。（ココは「"」はなし）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    Range("A1").Value = "No"                  'A1セルに「No」を入力
    Range("B1").Value = "X値"                 'B1セルに「X値」を入力
    Range("C1").Value = "Y値"                 'C1セルに「Y値」を入力
    Range("D1").Value = "X座標"               'D1セルに「X座標」を入力
    Range("E1").Value = "Y座標"               'E1セルに「Y座標」を入力
       
    Columns("G").ColumnWidth = 16                 'Gのセルの幅を16
    Range("G3:G8").HorizontalAlignment = xlCenter 'G3からG8範囲を中心揃え
    Range("G3:P38").RowHeight = 22                'G3からP38範囲の行の高さを22
    Range("H:N").ColumnWidth = 8                  'HからN範囲の幅を8
    Range("G3:G8").Interior.ColorIndex = 34       'G3からG8範囲のセル内を34番の色
    Range("I3").Interior.ColorIndex = 34          'I3のセル内を34番の色
    Range("K3").Interior.ColorIndex = 34          'K3のセル内を34番の色
    Range("M3").Interior.ColorIndex = 34          'M3のセル内を34番の色
    Range("K4").Interior.ColorIndex = 34          'K4のセル内を34番の色
    
    Range("H4:J4").Merge                          'H5からN5セルを結合
    Range("L4:N4").Merge                          'H5からN5セルを結合
    Range("H5:N5").Merge                          'H5からN5セルを結合
    Range("H6:N6").Merge                          'H6からN6セルを結合
    Range("H7:N7").Merge                          'H7からN7セルを結合
    Range("H8:N8").Merge                          'H8からN8セルを結合

    Range("G3").Value = "No"                      'G3セルに「No」を入力
    Range("I3").Value = "年齢"                    'I3セルに「年齢」を入力
    Range("K3").Value = "性別"                    'K3セルに「性別」を入力
    Range("M3").Value = "転倒回数"                'M3セルに「転倒回数」を入力
    Range("G4").Value = "視覚情報の有無"          'G4セルに「視覚情報の有無」を入力
    Range("K4").Value = "計測日"                  'K4セルに「計測日」を入力
    Range("L4").Value = Format(Date)             'L4セルに今日の日付を入力・・・①
    Range("G5").Value = "疾患"                    'G5セルに「疾患」を入力
    Range("G6").Value = "障害"                    'G6セルに「障害」を入力
    Range("G7").Value = "肢位"                    'G7セルに「肢位」を入力
    Range("G8").Value = "備考"                    'G8セルに「備考」を入力

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
個人情報を入力する欄の書式です。入力した文字や色を変えるには黒字の部分を変更します。

下から5行目の①Range("L4").Value = Format(Date) はデータ処理の日付を自動入力しています。計測日が処理日でないなら、この1行を消去します。（保存したら以降の処理はすべて日付なしになります。）

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  
    'データを作業用シートにコピーする
    Worksheets("Sheet0").Select                             'sheet0を選択・・・②
    Range("A1:B" & Range("B1").End(xlDown).Row).Copy _
    Destination:=Worksheets("作業用").Range("B2")        'A1からB列最終行までコピーし作業用シートのB2に貼り付け
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
②sheet0のデータを壊さない、消去しないように、作業用シートに貼り付けます。
ですから、sheet1にデータがあるからそのまま処理したいという場合には"sheet0"をそのシート名にします。その時は他のsheet0が出てくるところも変更してください。「検索」でsheet0調べてね。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

    '座標を求める
    Worksheets("作業用").Select                             '作業用シートを選択
    Range("D2").Formula = "=B2/40*43"                       'D2にB2÷40×43を入力  （※1）
    Range("D3").Formula = "=B3/40*43"                       'D3にB3÷40×43を入力
    Range("D2:D3").AutoFill Destination:=Range("D2:D7000")   'D2、D3のようにD7000まで入力
    
    Range("E2").Formula = "=C2/24*23.2"                     'E2にC2÷24×23.2を入力
    Range("E3").Formula = "=C3/24*23.2"                     'E3にC3÷24×23.2を入力
    Range("E2:E3").AutoFill Destination:=Range("E2:E7000")   'E2、E3のようにE7000まで入力

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
データはWiiボードの計測値なのでcm単位に直します。
リハビリテーションツール研究所の掲示板の吉村さんコメントから

出力された数値はセンサから得られた値そのままです。

Ｘ軸は－２０～＋２０、Ｙ軸は－１２～＋１２の範囲です。

一方、実際のバランスＷｉｉボードのセンサーは横４３㎝、縦２３．２㎝の間隔で設置されています。

したがって、出力されたＸ座標を４０で割って４３をかける、Ｙ座標を２４で割って２３．２をかけると㎝に変換できます。

とあるので計算式を入れました。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    '平均、標準偏差を求める
    Range("G12:G16").HorizontalAlignment = xlCenter          'G12からG16範囲を中心揃え
    Range("H11").Value = "X（cm）"                          'H11セルに「X（cm）」を入力
    Range("I11").Value = "Y（cm）"                          'I11セルに「Y（cm）」を入力
    Range("G12").Value = "平均"                             'G12セルに「平均」を入力
    Range("H12").Formula = "=AVERAGE(D2:D7000)"              'H12セルにD2からD7000の平均を入力
    Range("I12").Formula = "=AVERAGE(E2:E7000)"              'I12セルにE2からE7000の平均を入力
    
    Range("G13").Value = "標準偏差"                          'G13セルに「標準偏差」を入力
    Range("H13").Formula = "=STDEVP(D2:D7000)"                'H13セルにD2からD7000の標準偏差を入力
    Range("I13").Formula = "=STDEVP(E2:E7000)"                'I13セルにE2からE7000の標準偏差を入力
    
    '最大値、最小値を求める
    Range("G14").Value = "最大値"                            'G14セルに「最大値」を入力
    Range("H14").Formula = "=max(D2:D7000)"                   'H14セルにD2からD7000の最大値を入力
    Range("I14").Formula = "=max(E2:E7000)"                   'I14セルにE2からE7000の最大値を入力
    Range("G15").Value = "最小値"                            'G15セルに「最小値」を入力
    Range("H15").Formula = "=min(D2:D7000)"                   'H15セルにD2からD7000の最小値を入力
    Range("I15").Formula = "=min(E2:E7000)"                   'I15セルにE2からE7000の最小値を入力
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
平均は中心、最大値・最小値は矩形の辺になります。
標準偏差はとりあえず作ってみました。（標準偏差が何かをよくわかっていない）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
'矩形面積を求める
    Range("G16").Value = "矩形面積（cm2）"                   'G16セルに「矩形面積（cm2）」を入力
    Range("H16:I16").Merge across:=True                      'H16とI16セルを結合
    Range("H16").Formula = "=(H14-H15)*(I14-I15)"            '矩形の面積をH16セルに入力
   
   '矩形座標
    Range("K10").Value = "矩形"                              'K10セルに「矩形」を入力
    Range("K11").Value = "X（cm）"                           'K11セルに「X（cm）」を入力
    Range("L11").Value = "Y（cm）"                           'L11セルに「Y（cm）」を入力
    Range("K12").Value = "=(H14)"                            'K12セルにXの最大値を入力
    Range("L12").Value = "=(I15)"                            'L12セルにYの最小値を入力
    Range("K13").Value = "=(H15)"                            'K13セルにXの最小値を入力
    Range("L13").Value = "=(I15)"                            'L13セルにYの最小値を入力
    Range("K14").Value = "=(H15)"                            'K14セルにXの最小値を入力
    Range("L14").Value = "=(I14)"                            'L14セルにYの最大値を入力
    Range("K15").Value = "=(H14)"                            'K15セルにXの最大値を入力
    Range("L15").Value = "=(I14)"                            'L15セルにYの最大値を入力
    Range("K16").Value = "=(H14)"                            'K16セルにXの最大値を入力
    Range("L16").Value = "=(I15)"                            'L16セルにYの最小値を入力
    Range("M12").Value = "右下"                              'M12セルに「右下」を入力
    Range("M13").Value = "左下"                              'M13セルに「左下」を入力
    Range("M14").Value = "左上"                              'M14セルに「左上」を入力
    Range("M15").Value = "右上"                              'M15セルに「右上」を入力
    Range("M16").Value = "右下"                              'M16セルに「右下」を入力
 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
矩形の座標を求めました。
右下－左下－左上－右下と単純に入力するだけ作業なのに疲れました。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
    '罫線をひく
    Range("G3:N8").Borders.LineStyle = xlContinuous                'G3からN8の範囲に細実線をひく
    Range("G3:N8").Borders.ColorIndex = 33                         'G3からN8の線の色を33番（青）色にする
    
    Range("G11:I16").Borders.LineStyle = xlContinuous               'G11からI16の範囲に細実線をひく
    Range("G11:I16").Borders.ColorIndex = 33                        'G11からI16の線の色を33番（青）色にする
    Range("G11:I11").Borders(xlEdgeBottom).LineStyle = xlDouble     'G11からI11の下端の横線を二重線にする

    Range("K11:L16").Borders.LineStyle = xlContinuous              'K11からL16の範囲に細実線をひく
    Range("K11:L16").Borders.ColorIndex = 33                       'K11からL16の線の色を33番（青）色にする
    Range("K11:L11").Borders(xlEdgeBottom).LineStyle = xlDouble    'K11からL11の下端の横線を二重線にする

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
情報入力の表のところの罫線です。
色とか変えたかったら、黒字のコードを変更してください。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

うー、いっぱいになったから、あとは次回に

バランスWiiボードとPCで重心動揺計を作る ４

Excelでグラフにする　２

今回すること
２　このブログからマクロをコピーしてExcelに貼り付ける。


前回までで標準モジュールは挿入できていますね。

今回はマクロ（コード）を設定します。

先に言っとく。VBA初級者の無理やりなチカラ技です。コードも美しくありません。
できたものは中央揃いになってないところとかバラバラです。
VBAができる方はこのコードをタタキ台にして効率よく、美しく書き直して使ってください。（←ぶっ放し）

まず、生データのシートの名前を「sheet0」に直しておく。おそらくデータはsheet1から順に入っていると思うので、シートを間違わないようにしました。そしてデータはA1：B1セルを先頭にすること。

計測値はプロトコルに従えば60秒＝6000ケタですが、前後余裕を見て7000ケタ計算します。このへんはご自分で変更できるように解説をつけてあります。（後日くわしくお伝えします。）
追記：変更すると計算できなくなるので変更しないでください。

厳密に6000ケタもなくても、連続したデータがあれば大丈夫です。

Module1をダブルクリックすると右側が新しく開きます。

 そこへ下の赤線と赤線の間のコードを貼り付けます。
「空白セル」「作業シート」「プレビュー」大きく３つのコードでできていますが、ひとつずつ貼り付けではなく、赤線から赤線までひとかたまりでコピペ。

下部のコードはこのブログ上で変な位置で改行されていても絶対に段をイジらないこと！
貼り付けてうまくいくと行の後方の「‘」から後ろが緑字になるはず。（コメント欄なのだ）
保存をお忘れなく。

－－－－－－－－－－－－－－－－－－－－－－－－－

Sub 空白セル()
    Worksheets("sheet0").Select
    Range("H1").Formula = "=countIf((A1:B7000),""*"")"
    If Range("H1") > 0 Then MsgBox "文字型セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "文字型セル"
    
    Worksheets("sheet0").Range("A1:B7000").Select
    Dim Rng As Range
    Set Rng = Selection
    On Error GoTo errhandler
    Selection.SpecialCells(xlCellTypeBlanks).Select
    MsgBox "空白セルがありました。" & vbCrLf & "処理を中止します。", vbOKOnly, "空白セル"
    Set Rng = Nothing
    Exit Sub
errhandler:
    MsgBox "文字型セル、空白セルはありませんでした。処理を続けます。", vbOKOnly, "セル内容"
    If vbOK Then Call 作業シート
End Sub

Sub 作業シート()
    
    '作業用というシートを作る
    ActiveWorkbook.Sheets.Add.Name = "作業用"
   
    Range("g1").Value = "重心動揺計測"        'G1セルにタイトルを入力
    With Range("G1").Font                     'G1セルのフォントについて
        .Name = "MS明朝"                      'MS明朝体
        .Bold = True                          '太字
        .Color = vbBlue                       '青字
        .FontStyle = "斜体"                   '斜体
        .OutlineFont = True                   'アウトラインフォント
        .Size = 22                            '22ポイント
    End With

    Range("A1").Value = "No"                  'A1セルに「No」を入力
    Range("B1").Value = "X値"                 'B1セルに「X値」を入力
    Range("C1").Value = "Y値"                 'C1セルに「Y値」を入力
    Range("D1").Value = "X座標"               'D1セルに「X座標」を入力
    Range("E1").Value = "Y座標"               'E1セルに「Y座標」を入力
       
    Columns("G").ColumnWidth = 16                 'Gのセルの幅を16
    Range("G3:G8").HorizontalAlignment = xlCenter 'G3からG8範囲を中心揃え
    Range("G3:P38").RowHeight = 22                'G3からP38範囲の行の高さを22
    Range("H:N").ColumnWidth = 8                  'HからN範囲の幅を8
    Range("G3:G8").Interior.ColorIndex = 34       'G3からG8範囲のセル内を34番の色
    Range("I3").Interior.ColorIndex = 34          'I3のセル内を34番の色
    Range("K3").Interior.ColorIndex = 34          'K3のセル内を34番の色
    Range("M3").Interior.ColorIndex = 34          'M3のセル内を34番の色
    Range("K4").Interior.ColorIndex = 34          'K4のセル内を34番の色
    
    Range("H4:J4").Merge                          'H5からN5セルを結合
    Range("L4:N4").Merge                          'H5からN5セルを結合
    Range("H5:N5").Merge                          'H5からN5セルを結合
    Range("H6:N6").Merge                          'H6からN6セルを結合
    Range("H7:N7").Merge                          'H7からN7セルを結合
    Range("H8:N8").Merge                          'H8からN8セルを結合

    Range("G3").Value = "No"                      'G3セルに「No」を入力
    Range("I3").Value = "年齢"                    'I3セルに「年齢」を入力
    Range("K3").Value = "性別"                    'K3セルに「性別」を入力
    Range("M3").Value = "転倒回数"                'M3セルに「転倒回数」を入力
    Range("G4").Value = "視覚情報の有無"          'G4セルに「視覚情報の有無」を入力
    Range("K4").Value = "計測日"                  'K4セルに「計測日」を入力
    Range("L4").Value = Format(Date)             'L4セルに今日の日付を入力
    Range("G5").Value = "疾患"                    'G5セルに「疾患」を入力
    Range("G6").Value = "障害"                    'G6セルに「障害」を入力
    Range("G7").Value = "肢位"                    'G7セルに「肢位」を入力
    Range("G8").Value = "備考"                    'G8セルに「備考」を入力
    
    'データを作業用シートにコピーする
    Worksheets("Sheet0").Select                             'sheet0を選択
    Range("A1:B" & Range("B1").End(xlDown).Row).Copy _
    Destination:=Worksheets("作業用").Range("B2")           'A1からB列最終行までコピーし作業用シートのB2に貼り付け

    '座標を求める
    Worksheets("作業用").Select                             '作業用シートを選択
    Range("D2").Formula = "=B2/40*43"                       'D2にB2÷40×43を入力  （※1）
    Range("D3").Formula = "=B3/40*43"                       'D3にB3÷40×43を入力
    Range("D2:D3").AutoFill Destination:=Range("D2:D7000")   'D2、D3のようにD7000まで入力
    
    Range("E2").Formula = "=C2/24*23.2"                     'E2にC2÷24×23.2を入力
    Range("E3").Formula = "=C3/24*23.2"                     'E3にC3÷24×23.2を入力
    Range("E2:E3").AutoFill Destination:=Range("E2:E7000")   'E2、E3のようにE7000まで入力
        
    '平均、標準偏差を求める
    Range("G12:G16").HorizontalAlignment = xlCenter          'G12からG16範囲を中心揃え
    Range("H11").Value = "X（cm）"                          'H11セルに「X（cm）」を入力
    Range("I11").Value = "Y（cm）"                          'I11セルに「Y（cm）」を入力
    Range("G12").Value = "平均"                             'G12セルに「平均」を入力
    Range("H12").Formula = "=AVERAGE(D2:D7000)"              'H12セルにD2からD7000の平均を入力
    Range("I12").Formula = "=AVERAGE(E2:E7000)"              'I12セルにE2からE7000の平均を入力
    
    Range("G13").Value = "標準偏差"                          'G13セルに「標準偏差」を入力
    Range("H13").Formula = "=STDEVP(D2:D7000)"                'H13セルにD2からD7000の標準偏差を入力
    Range("I13").Formula = "=STDEVP(E2:E7000)"                'I13セルにE2からE7000の標準偏差を入力
    
    '最大値、最小値を求める
    Range("G14").Value = "最大値"                            'G14セルに「最大値」を入力
    Range("H14").Formula = "=max(D2:D7000)"                   'H14セルにD2からD7000の最大値を入力
    Range("I14").Formula = "=max(E2:E7000)"                   'I14セルにE2からE7000の最大値を入力
    Range("G15").Value = "最小値"                            'G15セルに「最小値」を入力
    Range("H15").Formula = "=min(D2:D7000)"                   'H15セルにD2からD7000の最小値を入力
    Range("I15").Formula = "=min(E2:E7000)"                   'I15セルにE2からE7000の最小値を入力
    
    '矩形面積を求める
    Range("G16").Value = "矩形面積（cm2）"                   'G16セルに「矩形面積（cm2）」を入力
    Range("H16:I16").Merge across:=True                      'H16とI16セルを結合
    Range("H16").Formula = "=(H14-H15)*(I14-I15)"            '矩形の面積をH16セルに入力
   
   '矩形座標
    Range("K10").Value = "矩形"                              'K10セルに「矩形」を入力
    Range("K11").Value = "X（cm）"                           'K11セルに「X（cm）」を入力
    Range("L11").Value = "Y（cm）"                           'L11セルに「Y（cm）」を入力
    Range("K12").Value = "=(H14)"                            'K12セルにXの最大値を入力
    Range("L12").Value = "=(I15)"                            'L12セルにYの最小値を入力
    Range("K13").Value = "=(H15)"                            'K13セルにXの最小値を入力
    Range("L13").Value = "=(I15)"                            'L13セルにYの最小値を入力
    Range("K14").Value = "=(H15)"                            'K14セルにXの最小値を入力
    Range("L14").Value = "=(I14)"                            'L14セルにYの最大値を入力
    Range("K15").Value = "=(H14)"                            'K15セルにXの最大値を入力
    Range("L15").Value = "=(I14)"                            'L15セルにYの最大値を入力
    Range("K16").Value = "=(H14)"                            'K16セルにXの最大値を入力
    Range("L16").Value = "=(I15)"                            'L16セルにYの最小値を入力
    Range("M12").Value = "右下"                              'M12セルに「右下」を入力
    Range("M13").Value = "左下"                              'M13セルに「左下」を入力
    Range("M14").Value = "左上"                              'M14セルに「左上」を入力
    Range("M15").Value = "右上"                              'M15セルに「右上」を入力
    Range("M16").Value = "右下"                              'M16セルに「右下」を入力
    
    '罫線をひく
    Range("G3:N8").Borders.LineStyle = xlContinuous                'G3からN8の範囲に細実線をひく
    Range("G3:N8").Borders.ColorIndex = 33                         'G3からN8の線の色を33番（青）色にする
    
    Range("G11:I16").Borders.LineStyle = xlContinuous               'G11からI16の範囲に細実線をひく
    Range("G11:I16").Borders.ColorIndex = 33                        'G11からI16の線の色を33番（青）色にする
    Range("G11:I11").Borders(xlEdgeBottom).LineStyle = xlDouble     'G11からI11の下端の横線を二重線にする

    Range("K11:L16").Borders.LineStyle = xlContinuous              'K11からL16の範囲に細実線をひく
    Range("K11:L16").Borders.ColorIndex = 33                       'K11からL16の線の色を33番（青）色にする
    Range("K11:L11").Borders(xlEdgeBottom).LineStyle = xlDouble    'K11からL11の下端の横線を二重線にする


    'グラフ作成
    Range("B4:C20").Select                                     'B4からC20の範囲を選択
    Charts.Add                                                 'グラフを挿入する
    ActiveChart.ChartType = xlXYScatterSmooth                   'グラフタイプは平滑線付き散布図
    ActiveChart.SetSourceData Source:=Sheets("作業用").Range("D2:E7000"), PlotBy:= _
        xlColumns                                                                     'データは作業用シートのD2からE7000
    ActiveChart.Location Where:=xlLocationAsObject, Name:="作業用"
    ActiveChart.SeriesCollection(1).Name = "重心軌跡"
     With ActiveSheet.ChartObjects("グラフ 1")                          '現在のシートの「グラフ1」は
        .Top = Range("G18").Top                                         '上端をG18セルに配置
        .Left = Range("G18").Left                                       '左端をG18セルに配置
                                             
    End With

    ActiveChart.Axes(xlValue).Select                            'アクティブグラフを選択
    With ActiveChart.Axes(xlValue)                              'グラフX軸について
        .MinimumScale = -20                                     '最少値を-20Cm
        .MaximumScale = 20                                      '最大値を20Cm
        .MinorUnitIsAuto = True                                 '最少目盛は自動
        .MajorUnit = 5                                          '最大目盛を5Cm
        .Crosses = xlAutomatic                                  '交点は自動
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    
    With ActiveChart.Axes(xlCategory)                           'グラフY軸について
        .MinimumScale = -20                                     '最少値を-20Cm
        .MaximumScale = 20                                      '最大値を20Cm
        .MinorUnitIsAuto = True                                 '最少目盛は自動
        .MajorUnit = 5                                          '最大目盛を5Cm
    End With

    '矩形グラフ
    ActiveChart.SeriesCollection.NewSeries.MarkerStyle = xlMarkerStyleNone     'アクティブグラフに新規グラフを追加
    ActiveChart.SeriesCollection(2).XValues = "='作業用'!$K$12:$K16"            'X値は作業用シートK12からK16
    ActiveChart.SeriesCollection(2).Values = "='作業用'!$L$12:$L$16"            'Y値は作業用シートL12からL16
    ActiveChart.SeriesCollection(2).Points(2).Select                           '新規グラフを選択
    ActiveChart.SeriesCollection(2).ChartType = xlXYScatterLinesNoMarkers      '折れ線グラフでマーカーなし
    ActiveChart.SeriesCollection(2).Name = "矩形"                              '系列名を「矩形」
    
    '中心点ドット
    ActiveChart.SeriesCollection.NewSeries.MarkerStyle = xlMarkerStyleDot     'アクティブグラフに新規グラフを追加
    ActiveChart.SeriesCollection(3).XValues = "='作業用'!$H$12"                'X値は作業用シートH12
    ActiveChart.SeriesCollection(3).Values = "='作業用'!$I$12"                 'Y値は作業用シートI12
    ActiveChart.SeriesCollection(3).Name = "中心点"                           '系列名を「中心点」
    
    With Range("G13:O30")
        ActiveSheet.ChartObjects("グラフ 1").Width = .Width
        ActiveSheet.ChartObjects("グラフ 1").Height = .Height
    End With
    
    
    ActiveChart.HasTitle = True                                 'アクティブグラフのタイトル
    ActiveChart.ChartTitle.Text = "重心動揺計測　単位（cm）"    '「重心動揺計測　単位（cm）」を入力
    ActiveChart.ChartTitle.Font.Size = 16                       'フォントを16ポイント
    
    'プレビューボタンを作る
    ActiveSheet.Buttons.Add(536.25, 6, 42.75, 14.25).Select
    Selection.OnAction = "プレビュー"
    ActiveSheet.Shapes("Button 1").Select
    Selection.Characters.Text = "プレビュー"
    With Selection.Characters(Start:=1, Length:=5).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "標準"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone

    End With
    Selection.ShapeRange.ScaleWidth 1.86, msoFalse, msoScaleFromTopLeft
      
    'シート名変更
        Worksheets("作業用").Name = "重心動揺" & Format(Time, "hhnn")
    
        MsgBox "処理が完了しました。", vbOKOnly, "完了"
        Worksheets(1).Select
End Sub

Sub プレビュー()
    ActiveSheet.PageSetup.RightFooter = "Powerd by KITA Ver1.00"
    Range("G1:O36").PrintPreview                                'G1からO40セルの範囲をプレビュー表示

End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－

やる気マンマンの人はいきなりやってみましょう。

sheet0にデータがある上で、コード先頭の「Sub　空白セル（ ）」の「S」の字にカーソルを置いて、プレイボタンをクリックする。

もし一覧が表示されてどのマクロを実行するか聞かれたら、「空白セル」を実行してください。

うまくいけば「文字型セル、空白セルはありませんでした。処理を続けます。」と出るので「OK」をクリックすれば、自動ランします。









－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

つまり、「文字型セル、空白セル」があれば、処理が中止され、そこから進みません。

「文字型セル、空白セル」がどこにあるか、はデータ処理には関係ないので今回ははしょります。
ヒント、どこにあるかは、文字型セルはSUM（その範囲）で参照できないセルを探す。
空白セルはExcel、空白セルでググるといっぱいある。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

「処理が完了しました。」と出て作業完了！

このときVBAじゃなくてExcelのシートのほうに「重心動揺○○○○」というシートができてます。
○のところは処理した時間ね。（何人か計測するとどれだっけ？にならないために）


プレビューボタンで印刷画面もみられます。（ケタが多いとプレビュー出すのも大変だから作ってみた）

例えばコードのRange(A1:B7000)をRange(A1:B5000)に変更すれば、A1:B7000の範囲からA1:B5000の範囲に変更して処理させることができます。処理内容は緑字のコメントに書いてあります。

2013年5月7日追記
カズオさんからのコメントで
「エクセル2002を使い、20秒のデータで計算したかったため、Range(A1:B2000)にしたのですが、空白セルなし→OK→“RangeクラスのSelectメソッドが失敗しました”とエラーメッセージが出てしまいます。」とありました。

ごめんないさい。　
「7000」をイジると、以降のすべての「7000」を修正しないといけないので、そのままでやってください。
もし「7000」より多い「8000」に直すならば、その行以降のすべての「7000」を検索して「8000」に置換してください。（結構たくさんあるのでシンドいです）

今回もボリューム満点だったので、各項目の解説は次回に。

バランスWiiボードとPCで重心動揺計を作る ３

Excelでグラフにする

データがCドライブに入っただけではすぐに使えないし、患者様にお見せできないので、少しの操作でグラフが印刷できるようVBAを組みました。

すること
１　Excelのマクロを使えるようにする。
２　このブログからマクロをコピーしてExcelに貼り付ける。
３　マクロを実行してデータ操作ができるようにする。

まず、今回は　１　Excelのマクロを使えるようにする。

はじめに「開発」 タブを表示する。（すでに「開発」タブが表示されていればこの作業は必要なし）

 (Microsoft Office ボタン をクリックし、[Excel のオプション]をクリックする。

.











[基本設定] をクリックし、
[[開発] タブをリボンに表示する] チェック ボックスをオンにする。

 「開発」タブが表示された。

 「開発」タブをクリックする。










「コードの表示」をクリックする。

「Microsoft Visual Basic」が表示されるので、
「挿入」－「標準モジュール」をクリックする。

すでに「標準モジュール」を組んであるクロートの人はすっ飛ばしてください。
そんな人はココ見ないか・・・






次の「マクロを貼り付ける」のマクロが、ちょっとしたところでつまづいているので、今回はここまで。