韜晦日記

韜晦日記

Rietveldよりもプログラミングメインになりつつある

Rietveld解析初心者による備忘録とつぶやき

シーケンシャルな解析の為にマクロを組む No.2

疲れますた。

.insファイルの読み込み

VBAで解析をする上で肝になるのが、実行ファイルの書き込みです。VBAのお勉強3日目。まだまだ使いこなせていない所存でごんす。
一先ず、insファイルを読み込み新しいシートに1行づつ書き込んで、ファイルを弄っていこうと思います。

説明がめんどくさいのでソースコードだけ貼っておきます。説明はまた今度。

Sub read()
    Dim OpenFileName As String
    OpenFileName = Application.GetOpenFilename("RIETAN ファイル,*.ins?")
    Dim buf As String, wb As Workbook
  
    ''ファイルの存在チェック
    buf = Dir(OpenFileName)
    If buf = "" Then
        MsgBox OpenFileName & vbCrLf & "は存在しません", vbExclamation
        Exit Sub
    End If
    
    MsgBox Right(OpenFileName, InStr(StrReverse(OpenFileName), "\") - 1)
    '開いたファイルの名前を定義, OpenFileNameにはファイルのパスが
    '格納されている為、ファイル名だけを抽出する必要がある。
    '参考[http://www.relief.jp/docs/excel-vba-function-instr-strreverse.html]
    Dim SheetName As String
    SheetName = Right(OpenFileName, InStr(StrReverse(OpenFileName), "\") - 1)
    
    ''同名シートのチェック
    Dim i As Long
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = SheetName Then
            MsgBox SheetName & vbCrLf & "はすでに開いています", vbExclamation
            Exit Sub
        End If
    Next i
    
   '今後、進行状況を表示為に指定したinsファイルの行数のカウント
    Dim FSO As Object
    If OpenFileName = "False" Then Exit Sub
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO.OpenTextFile(OpenFileName, 8)
        MsgBox Dir(OpenFileName) & "は、" & .Line & "行あります。", vbInformation
        .Close
    End With
    Set FSO = Nothing

    'ワークシートを最後尾に新規作成し、指定したファイル名にする。
    With Worksheets.Add(after:=Worksheets(Worksheets.Count))
    .Name = SheetName
    End With
    
    'ファイルを開いて一行づつ読み込み
    Dim lr As String, n As Long
    Open OpenFileName For Input As #1
        Do Until EOF(1)
        Line Input #1, lr
            n = n + 1
            Cells(n, 1) = lr
        Loop
    Close #1
End Sub