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 & "個のファイルを変換しました.")

2014年11月10日月曜日

UNC変換

社内メールで「サーバーに上げたから、Y:\foo\baaを見てね」とか来るけど、あなたのYドライブのマウント先は私のYドライブのマウント先ではないのだよ!

先にUNC(絶対パスみたいなもの)に変換してから送ってほしいけど面倒なんだよね。
AutoItにはUNC変換APIがあるから作ってみる。

YドライブとかのファイルとかをD&DするとクリップボードにUNCパスがコピーされます。
結果表示はトレイチップにしてますがお好みで。



#Include <winnet.au3>

; コマンドライン引数がない場合終了
If $arg[0] = 0 Then Exit

; 第一引数のみ取得する
$sLocalPath = $arg[1]

; UNCに変換
$retval = _WinNet_GetUniversalName($sLocalPath)
$UNCName = $retval[0]
$NetworkName = $retval[1]
$RemainPath = $retval[2]

; UNC変換されたかどうか確認
if $UNCName == 0 Then
   $path = $sLocalPath
Else
   $path = $UNCName
EndIf

; 結果表示
;MsgBox(0, "UNCName", $path)
TrayTip(@ScriptName, $path, 1, 1)

; クリップボードに入れる
ClipPut ($path)
; トレイチップが一定時間表示し続けるように
Sleep(3000)

2011年1月5日水曜日

windows「ファイル名が長すぎます」と言われて削除できないファイル

バッファローの外付けHDDについてきたバックアップソフトがヒドかった。
詳しい説明もなくとにかくおまかせでバックアップするソフトで、実行したら1TのHDDが3日で一杯に。( ゚д゚)
わけわからんのでソフト停止、fileも消そうと思ったら、「ファイル名が長すぎます」の連呼状態。
数が多すぎるのでいちいち8.3形式調べて消すわけにもいかず。マジでスクリプト組もうかと思った。

いろいろ調べたらsubstコマンド使う方法があった。
(1) コマンドラインでsubstを使い、適当なパスを適当なドライブ名に割り当てる。(パス名が短くなる)
(2) ドライブ以下をエクスプローラなりDELコマンドなりで削除する。
(3) substの/dオプションで割り当て解除

うまくいきました。

2010年9月15日水曜日

苺perl

会社のWindowsPCはリモート監視されてるので勝手にソフトインストール出来ない。
それでPerlでインストーラ無し版を探していたらポータブル版を見つけた。
↓の下の方。
http://strawberryperl.com/

ストロベリーパール...変な名前だけど使えるからよしとしよう。

2010年9月1日水曜日

FreeMat

FreeMatしばらく使ってなかったら、知らない間に4.0になってた。

2010年5月3日月曜日

フォルダ以下のファイルを

【種類】
javascriptでWSH(Windows)

【機能】
指定フォルダ以下のファイルに対して何らかの処理を行います。
(本スクリプトでは処理部は実装していません。)
ドラッグ&ドロップで渡されたパスをルートパスとして実行します。
ファイル検索パターンで拡張子などを指定できます。(正規表現)


var fs = new ActiveXObject("Scripting.FileSystemObject");
var files = new Array();
var searchext = /\.bmp$/i; // ファイル検索パターン (例ではbmpファイル)

// D&Dの引数をルートパスにする
strRootPath = WScript.Arguments(0)

// 指定フォルダ以下の全ショートカットリストを取得
GetAllSubFiles(strRootPath, files, searchext);

for (i in files) {
  //ここに処理を実装する。files[i]でファイル名を取り出す。

}

//****************************************************************
// 指定パス以下の指定された正規表現にマッチしたパスのリストを取得
//****************************************************************
function GetAllSubFiles(path, fileList, reg) {
 // フォルダオブジェクト取得
 var f = fs.GetFolder(path)
 // すべてのファイルを抽出
 var fc = new Enumerator(f.Files);
 for(; !fc.atEnd(); fc.moveNext()) {
  strPath = fc.item().Path
  // 正規表現にマッチしたものだけリストに追加
  if (strPath.match(reg)) {
   fileList.push(strPath);
   //WScript.echo(strPath);
  }
 }
 //すべてのサブフォルダ
 var subfc = new Enumerator(f.SubFolders);
 for(; !subfc.atEnd(); subfc.moveNext()) {
  GetAllSubFiles(subfc.item().Path, fileList, reg); // 再帰
 }
}