書斎仮想化

主にプログラムに関連した記事を投稿していきます。なるべく素早く導入して頂けるよう、独自の粒度で情報をまとめることをモットーに記事を執筆しております。

Excelのセルをダブルクリックしてファイルをセルに出力するコピペ

はじめに

開発環境

コピペ場所

VBA Projectの任意の場所にコピーしてお使いください。

例)VBA Project > Microsoft Excel Objects > Sheet1 (Sheet1)に貼り付けるなど

f:id:readyhawker:20180617010905j:plain

ポイント

動作

  • セルB2をクリックする
  • Excelブックが存在するディレクトリの「filelist.txt」を読み込む
  • セルB2~Bnに読み込んだファイルを1行ずつ出力する

結論

コピペ内容

' セルのクリックイベント
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 変数宣言
    ' クリックセル位置
    Dim clickRow As Integer
    Dim clickCol As Integer
    
    ' 変数設定
    clickRow = 2
    clickCol = 2
    
    ' セルクリックイベントの位置を設定
    If (Target.row = clickRow And Target.Column = clickCol) Then
        Call readFileAction
    End If
End Sub

' ファイル読み込みアクション
Sub readFileAction()
    ' 変数宣言
    ' 読み込みファイル名とセル出力位置
    Dim fileName As String
    Dim outCellRow As Integer
    Dim outCellCol As Integer

    ' 変数設定
    fileName = "filelist.txt"
    outCellRow = 2
    outCellCol = 2
    
    ' ファイルの読み込みとセルに出力
    Call readFileAndCellOutAction(fileName, outCellRow, outCellCol)
    
    MsgBox "ファイルを読み込みました"
End Sub

' ファイルの読み込みとセルに出力
Function readFileAndCellOutAction(ByVal fileName As String, ByVal row As Integer, ByVal col As Integer)
    ' 変数宣言
    ' ファイル1行読み込み
    Dim line As String
    ' 出力セルの行移動カウンタ
    Dim outRowCounter As Integer
    
    ' 変数設定
    outRowCounter = 0
    
    ' ファイル読み込み
    Open ThisWorkbook.Path & "\" & fileName For Input As #1
        Do Until EOF(1)
            Line Input #1, line
            ' 1行を指定のセルに出力する
            Cells(row + outRowCounter, col).Value = line
            outRowCounter = outRowCounter + 1
        Loop
    Close #1
End Function

出力結果

f:id:readyhawker:20180616220003j:plain

おわりに

地味に毎回作っているので、コピペ化しました。ご自由にお使いください。