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

2020年4月22日水曜日

パワポの背景色と文字色を一括変更するVBS

「大量のパワポファイルの背景色と文字色を一括変更したい」という要望があったのでVBSで作成。Windows専用。
(背景色はスライドマスターの背景色)

(1)ファイルをダウンロード
または下記コードをメモ帳やエディタなどにコピペし「パワポの背景色と文字色を一括変更する.VBS」として保存
(2)メモ帳やエディタで色指定を適宜修正
(3)対象のパワポファイルと同じフォルダに置く
(4)ダブルクリックして実行

注意:ファイルを直接書き換えるのでバックアップとること

ソースコード(参考)
' ----------------------------------------
' パワポの背景色と文字色を一括変更するVBS
' ----------------------------------------

' 色指定
bgColor = RGB(0, 255, 0) ' 背景色指定
fontColor = RGB(255, 255, 255) ' 文字色指定

' RGBではなく色名で指定しても良い
' vbBlack
' vbBlue
' vbCyan
' vbGreen
' vbMagenta
' vbRed
' vbWhite
' vbYellow

' スクリプトのパス
lengthPath = len(wscript.scriptfullname) - len(wscript.scriptname)
path = left(wscript.scriptfullname,lengthPath)

' ファイルシステムオブジェクト
Set objFso = CreateObject("Scripting.FileSystemObject")

' パワーポイントオブジェクト
Set objPPApp = CreateObject("PowerPoint.Application")

'全ファイルについて処理
count = 0
For Each file In objFso.GetFolder(path).Files
    If objFso.GetExtensionName(file) = "ppt" OR objFso.GetExtensionName(file) = "pptx" Then ' パワーポイントのみ
        With objPPApp
            .Visible = True
            .Presentations.Open file   ' ファイル開く
            With .ActivePresentation
                .SlideMaster.Background.Fill.ForeColor.RGB = bgColor ' スライドマスター背景色変更
                ' 文字色を変更する
                 For Each sld in .Slides ' 全スライド
                    For Each shp In sld.Shapes ' 全シェイプ
                        shp.TextFrame.TextRange.Font.Color = fontColor
                    Next
                Next
                .Save   ' 保存
                .Close  ' 閉じる
            End With
        End With
    count = count + 1
    End If
Next
msgbox(count & "個のファイルを変換しました.")