SENDSTRでテキストを記入できるフォームと出来ない場合があり、KBDでタイプさせる手もあるが、クリップボードを使うと汎用性が高い
例
str = “記入したい文字”
// IDを0指定にするとクリップボードへセット
SENDSTR(0,str)
記録で貼り付けたい位置を選択して調べる
例
BTN(LEFT,CLICK,441,484,300)
位置を選択後、貼り付け
SCKEY(0,VK_CTRL,V) // ペースト
SENDSTRでテキストを記入できるフォームと出来ない場合があり、KBDでタイプさせる手もあるが、クリップボードを使うと汎用性が高い
例
str = “記入したい文字”
// IDを0指定にするとクリップボードへセット
SENDSTR(0,str)
記録で貼り付けたい位置を選択して調べる
例
BTN(LEFT,CLICK,441,484,300)
位置を選択後、貼り付け
SCKEY(0,VK_CTRL,V) // ペースト
画面をスクロールさせるのに、CTRL+ENDやCTRL+HOMEを使っているが、ツールボタンに追加して、クリックするだけで移動できるようにする
ツールバーアドオンに追加で実行を設定する
タイプをVBScriptでオプションに以下を記述
Set WshShell = CreateObject(“WScript.Shell”)
WshShell.SendKeys (“^{END}”)
Set WshShell = CreateObject(“WScript.Shell”)
WshShell.SendKeys (“^{HOME}”)
または、タイプを実行で
Tablacus ExplorerフォルダへVBSファイルの格納してこれを実行
VBSのキー・ストローク送信を実行する
※下記のコードコピーする時は”を半角に変更すること
<end.vbs>
Set objShell = WScript.CreateObject(“WScript.Shell”)
objShell.SendKeys “^{END}”
<home.vbs>
Set objShell = WScript.CreateObject(“WScript.Shell”)
objShell.SendKeys “^{HOME}”
注意 このブログは、’と“”が全角に置き換わるので、vbsファイルへコピー後に、半角のシングルクォーテーションと半角のダブルクォーテーションに置き換えること
※ “と”をダブルクォーテーションに置き換える
Option Explicit
‘************************
‘カレントディレクトリのファイル名の半角をアンダーバーに置き換える
Dim after
Dim objFolder
Dim objFile
Dim objFileSys
Dim strExtension
Dim myPath
Dim objShell
Set objShell = CreateObject( “WScript.Shell” )
myPath = objShell.CurrentDirectory ‘myPathをカレントディレクトリ指定 ここを変更すると任意のディレクトリにも出来る
Set objShell = Nothing
‘ファイルシステムを扱うオブジェクトを作成
Set objFile = CreateObject(“Scripting.FileSystemObject”)
Set objFileSys = CreateObject(“Scripting.FileSystemObject”) ‘拡張子取得用
‘フォルダのオブジェクトを取得
Set objFolder = objFile.GetFolder(myPath)
‘FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
For Each objFile In objFolder.Files
‘ファイルの拡張子を取得
strExtension = objFileSys.GetExtensionName(objFile.Name)
If strExtension <> “” Then ‘<>””は未指定、=”pptx”等で拡張子を指定できる
If InStr(objFile.Name,” “) Then ‘空白を含む場合のみ処理
after = Replace(objFile.Name,” “,”_”)
‘ファイル名変更
objFile.Name = after
End If
If InStr(objFile.Name,” ”) Then ‘全角の空白も処理にしている 不要ならコメントアウト
after = Replace(objFile.Name,” ”,”_”)
‘ファイル名変更
objFile.Name = after
End If
End If
Next
Set objFile = Nothing
Set objFileSys = Nothing
Set objFolder = Nothing
Wscript.Echo “完了しました” ‘不要ならコメントアウト
スクリプトを実行したフォルダ内のPowerPointファイルから画像を抽出
色の再現度がJPGよりPNGの方が良かったので設定(変更も可能)
読み込みフォルダも出力フォルダもカレントディレクトリにしているが、固定で指定することも可能
ファイル名の半角空白があると誤動作して、プロセスにPowerPointが残り、手動で終了させないといけなくなるので、半角の空白はアンダーバーで置き換える処理を先にする
注意 このブログは、’と“”が全角に置き換わるので、vbsファイルへコピー後に、半角のシングルクォーテーションと半角のダブルクォーテーションに置き換えること
※ “と”をダブルクォーテーションに置き換える
pptxファイルから画像ファイルを抽出.vbs のサンプルコード
Option Explicit
‘************************
‘ myPathで指定したフォルダ内ファイルに含まれる半角空白を_に置き換える
Dim after
Dim objFolder
Dim objFile
Dim objFileSys
Dim strExtension
Dim myPath
Dim objShell
Set objShell = CreateObject( “WScript.Shell” )
myPath = objShell.CurrentDirectory
Set objShell = Nothing
‘ファイルシステムを扱うオブジェクトを作成
Set objFile = CreateObject(“Scripting.FileSystemObject”)
Set objFileSys = CreateObject(“Scripting.FileSystemObject”) ‘拡張子取得用
‘フォルダのオブジェクトを取得
Set objFolder = objFile.GetFolder(myPath)
‘FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
For Each objFile In objFolder.Files
‘ファイルの拡張子を取得
strExtension = objFileSys.GetExtensionName(objFile.Name)
If strExtension = “pptx” Then
If InStr(objFile.Name,” “) Then ‘空白を含む場合のみ処理
after = Replace(objFile.Name,” “,”_”)
‘ファイル名変更
objFile.Name = after
End If
End If
Next
Set objFile = Nothing
Set objFileSys = Nothing
‘***********************必要な設定をppSaveAsXXXで指定
Const ppSaveAsBMP = 19
Const ppSaveAsPNG = 18
Const ppSaveAsJPG = 17
Const ppSaveAsGIF = 16
Const ppSaveAsHTML = 12
Const ppSaveAsDefault = 11
Const ppSaveAsPDF = 32
Const ppSaveAsPowerPoint3 = 4
Const ppSaveAsPowerPoint4 = 3
Const ppSaveAsPowerPoint7 = 2
Dim fname, ppt
‘ File System Object
Dim objFso
Set objFso = CreateObject(“Scripting.FileSystemObject”)
‘ Wsh Shell
Dim objWshShell
Set objWshShell = WScript.CreateObject(“WScript.Shell”)
Dim strPath
Dim outPath
Dim imgName
Set objShell = CreateObject( “WScript.Shell” )
strPath = objShell.CurrentDirectory
Set objShell = Nothing
Dim obj ‘As Object
For Each obj In objFso.getfolder(strPath).Files
If Right(obj.Name,5) = “.pptx” and Left(obj.Name,1) <> “~” Then ‘~$の一時ファイルが残っていてエラーとなることあったので対策
fname = strPath & “\” & obj.Name
Set ppt = GetObject(fname)
ppt.SaveAs ppt.FullName, ppSaveAsPNG ‘ppt.FullNameでファイル名のフォルダを作って、格納 ppt.FullNameの部分をパスを記載して出力先を固定にすることも可能 事前にフォルダの作成が不要(作成される)
ppt.Close
End If
Next
Set objFso = Nothing
‘スクリプトエラーでパワーポイントのプロセスが残った時の対策
objWshShell.Run “taskkill /im POWERPNT.EXE /F /T”, 7, False ‘ウィンドウを最小化ウィンドウとして表示アクティブなウィンドウは切り替わらない コマンドの終了を待たない
Set objWshShell = Nothing
Wscript.Echo “完了しました”
知り合いから回復依頼
マルウェアらしきものに感染し、050*****に電話させられ、費用を要求され、よく分からずリモート設定までしてしまったとの事
スタートメニュー等々が開かなくなっており、再起動したらPINコードが壊れているとのことでログインすら出来ない状態
対処
BIOSでUSB起動にして、WindowsをUSB起動して、隠し技でコマンドプロンプトを埋め込む
Shft+F10 Utilman.exe cmd.exe
通常起動、コマンドプロンプトでローカルアカウントを作成し、管理者グループへ入れて、ログイン
net user admintemp /add PassworsXX
net localgroup administrators admintemp /add
操作が効かないので、コマンドで設定を起動してみるが、エラー
復元でもポイントが見つからないとのメッセージ
アカウント管理もエラー、PCリセットもNG
一旦、サインアウトすると、再度、ログイン出来なくなり、再度、ローカルアカウントを作成する必要あり。
コマンドでrstrui.exe も復元ポイント見つからない
コマンドで、systemreset -factoryreset でPCリセットもエラーで実行不可
諦めて、再度、USBでWindows10起動
メーカのリカバリメディアも何もないとの事で、最悪、初期化してWindows10をインストールしようと進める
直ぐにインストール画面の下の回復をやってみると、Windows11を復元が選べる
試しにやってみると、直近の自動保存イメージからリカバリで出来た
結果的にPCリセットしなくても良かったので、結果オーライ
タスクマネージャーで不審なタスクが無いか確認
スタートアップとサービスもチェック
ブラウザの履歴なども念のため削除で一応、問題なし
DoやFor文を抜けるには、Exit
以降のマクロ処理をしないで、終了させるには、End
// Close操作の例
ID = GETID(“Chrome”)
IFB ID <> -1 Then // Chromeが表示されている時
CTRLWIN(GETID(“Chrome”),CLOSE)
ENDIF
// taskkillですべてのプロセス指定(子プロセスも含む必要があるときは /T も指定)
ID = GETID(“Chrome”)
IFB ID <> -1 Then // Chromeが表示されている時
DosCmd(“taskkill /F /IM <#DBL>CHROME.EXE<#DBL>”,TRUE,FALSE)
ENDIF
SLEEP(1)
ID = GETID(“Edge”)
IFB ID <> -1 Then // Edgeが表示されている時
DosCmd(“taskkill /F /IM <#DBL>msedge.EXE<#DBL> /T”,TRUE,FALSE)
ENDIF
エクセルで、シートをコピーしたりして利用する場合に、名前が定義されていると重複メッセージが出ることがある
名前定義を削除、変更したいときは、数式の名前の管理か、CTRL+F3キーで管理画面を呼び出す
スケジュールで実行しているスクリプトを修正したら、記述ミスでエラーメッセージが表示されて以降のスケジュールも停止した。
スケジュール設定で、別プロセスで実行にチェックを入れておけば、エラーメッセージが出たスクリプトは、そのままで次のスケジュールが実行できる
エラーメッセージを解除するために、UWSCを再起動する
DosCmd(“uwsc_restart1.bat”) // 再起動batを実行
uwsc_restart1.batは、
@echo off
start “” “C:\ProgramData\tools\uwsc_restart2.bat”
uwsc_restart2.batは
@echo off
ping localhost -n 3 > nul
taskkill /im UWSC.exe /F /T
ping localhost -n 5 > nul
start “” C:\ProgramData\tools\uwsc.exe
exit
※UWSCの特徴として、UWSCスクリプトが終了(本体を終了も同様)させると、実行中のものも終わってしまうことがある
uwsc_restart1.batのみで、uwsc_restart2.batの内容を実行すると、taskkill 以降の処理は実行されずに、batファイルが終わってしまう
そこで、startで別にbatファイルを実行すると、uwsc_restart1.batが終わっても、uwsc_restart2.batは独立して実行されるので、うまくいく
※それぞれのスクリプトは別プロセスで実行すること
この様なBATファイルを使わなくても、UWSCには、POFF( コマンド )という便利な機能があるが、別プロセスで実行しても、該当プロセス以外は対応できない。
同一プロセスだとエラーメッセージにOKをクリックしないと停止したままなので、上記のBATファイルでの処理が必要
SOUND(“BEEP”)やSOUND(“音ファイル名.wav”),SOUND(“音ファイル名.mp3”)でuwscは音を鳴らせるが、デフォルトは処理終了を待たないFalseになっている
その為、次の処理でMSGBOXの様に待機コマンドが無いと、再生前にUWSC自体が終了してしまい、再生が止まるので注意
ほとんど場合、TRUE指定が必要
MSGBOXで、OKをクリックするまで、再生が続き、OKをクリックするとUWSCが終了するので、再生が止まることが確認できる例
fileName = “アラーム.wav”
SOUND(fileName)
MSGBOX(“OK”)