2020年4月29日水曜日

選択したセルの内容をテキストに書き出すエクセルマクロ

選択したセルの内容をテキストに書き出すエクセルマクロです。
OBS Studioのテキストを動的に変更する目的で作成しました。

(1) ファイルをダウンロード
(2) テキストファイルを出力したいフォルダにエクセルファイルを置く
(3) エクセルファイルをひらき、セルに文字列を入力する
(4) 実行ボタンを押す(ボタンが引っ込んだ状態になる)
(5) セルをクリックするとテキストファイルが同じフォルダにできる
(6) OBS Studioでシーンにテキスト(GDI+)を追加する
(7) テキスト(GDI+)のプロパティのファイルからの読み取りをONにしテキストファイルを指定する
(8) エクセルでセルを選択すると、OBS Studio側の文字が変わる
(9) 実行をやめるときは、再度実行ボタンを押す(ボタンが戻る)


ソースコード(参考)
' --- 選択セル変更イベント処理 -----------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    ' 実行ボタンOFF時は動作しない (シートにトグルボタンを配置しておく)
    If ToggleButton1.Value <> True Then End
    
    ' 左端のときは動作しない
    If Target.Column = 1 Then End
    
    ' 複数選択時は動作しない
    If Target.Count > 1 Then End
    
    ' 左端がnullの場合は動作しない
    If IsNull(Cells(Target.Row, 1).Value) = True Then End
    
    ' 左端がnullの場合は動作しない
    If IsEmpty(Cells(Target.Row, 1).Value) = True Then End
    
    ' 左端が数字でない場合は動作しない
    If IsNumeric(Cells(Target.Row, 1).Value) <> True Then End
  
    ' ファイル名取得
    strFile = Cells(2, Target.Column).Value
    
    ' ファイル名が空の場合は動作しない
    If IsEmpty(strFile) = True Then End
    
    ' 文字列取得
    strText = Target.Value
    
    ' セル色変更
    For r = 3 To 100 ' 面倒なので100行目まで全部クリア
        Cells(r, Target.Column).Interior.ColorIndex = 0
    Next
    Target.Interior.Color = RGB(100, 255, 255)
    
    ' テキスト保存処理呼び出し
    Call SaveText(strText, strFile)
End Sub

' --- テキストファイル書き出し ------------------------
Private Sub SaveText(ByRef strText, ByRef sFile)
    ' ファイルのフルパス
    strFilePath = ThisWorkbook.Path & "\" & sFile
    ' テキスト書き出し(UTF-8, 上書き)
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .WriteText strText
        .SaveToFile strFilePath, 2
        .Close
    End With
End Sub

0 件のコメント:

コメントを投稿