FURUやんのScript忘備録

SEやプログラマではないFURUやんが自分で作ったり調べてカスタマイズしたりどこかから引用したりしたScriptや手順の忘備録です  このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証とサポートが無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

Photoshopの「別名で保存」でJPEGが選べなくなった問題が解決

pc.watch.impress.co.jp

 

さっき丁度コレにぶち当たってしばらく悩んだ

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

Win11でエクスプローラーで詳細表示の行間を狭くする

ex1.m-yabe.com

 

なにげに面倒くせー

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

Win10からアップデートすると隠しファイルの設定がリセットされる

ex1.m-yabe.com

 

なにげにメンドクサイなぁ

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

荒野行動をアンインストール出来る数少ない超強力なアンインストーラー

www.bcuninstaller.com

 

つか、荒野行動を完膚なきまでにアンインストール出来る奴はこれしか知らん。

強力アンインストーラー!とか謳っている奴はだいたい荒野行動には太刀打ちできないっぽい。(間違ってたらごめんちゃい)

 

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

【Windows 11】TPM2.0を有効にするBIOS設定の変更手順メモ(自作PCでWindows 11のシステム要件を満たすために行った設定変更)

did2memo.net

 

わりと困っている人居るんじゃないですかね。

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

excelのThisWorkbookに放り込んでおいてカレントに「old」フォルダを作っておくとセーブの度に履歴を「old」フォルダに保存して「保存しました」と喋ってくれるVBAのテスト

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


Const FOLD_NAME = "old"

Dim fold_path As String
Dim fold_path2 As String
Dim objFileSys
Dim strPath
Dim Y As String
Dim m As String
Dim d As String
Dim h As String
Dim s As String
Dim wb As String
Dim path2 As String

Dim Speaker

Dim wShell

Set objFileSys = CreateObject("Scripting.FileSystemObject")

  Set Speaker = CreateObject("sapi.spvoice")
  Speaker.Rate = -1
  Speaker.Volume = 100
  

strPath = objFileSys.GetExtensionName(ActiveWorkbook.Name)
strPath = "." & strPath

Y = Format(Now, "yyyy")
m = Format(Now, "MM")
d = Format(Now, "DD")
h = Format(Now, "HH")
MM = Format(Now, "NN")

fold_path2 = ActiveWorkbook.Path & "\" & FOLD_NAME
fold_path = ActiveWorkbook.Path & "\" & FOLD_NAME & "\" & Y & "\" & m
  
If Dir(fold_path2, vbDirectory) = "" Then
        Exit Sub
    Else
        If Dir(fold_path2, vbDirectory) = FOLD_NAME Then

        CreateFolder (fold_path)

End If

 
End If
   


wb = Replace(ActiveWorkbook.Name, strPath, "")


path2 = ActiveWorkbook.Path & "\" & FOLD_NAME & "\" & Y & "\" & m & "\" & wb & _
Format(Now(), "_yyyymmdd_hhmmss") & strPath
        
ActiveWorkbook.SaveCopyAs Filename:=path2

    
  Dim myShell As Object
  Set myShell = CreateObject("Wscript.Shell")
  myShell.PopUp "保存しました", 1, "1秒で窓は閉じます"
  
    
  'Set wShell = CreateObject("WScript.Shell")
  '最大音量

  'wShell.Run "sndvol.exe"
  'Application.Wait Now() + TimeValue("00:00:02")
  'wShell.SendKeys "{home}{esc}"
  
  '最小音量
  'Set wShell = CreateObject("WScript.Shell")
  'wShell.Run "sndvol.exe"
  'Application.Wait Now() + TimeValue("00:00:02")
  'wShell.SendKeys "{end}{esc}"
    
  Speaker.Speak "保存しました"
  
  Set myShell = Nothing
  

  
End Sub

 

 


Public Function CreateFolder(strFolderPath As String)
 
    ' パスを\区切りで分ける
    Dim varFolders As Variant   ' フォルダ名リスト
    varFolders = Split(strFolderPath, "\")
 
    ' FileSystemObjectをインスタンス化する
    Dim objFileSystemObject As Object   ' FileSystemObjectオブジェクト
    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
    ' フォルダを作成する
    Dim varValue As Variant     ' フォルダ名リストから取り出したフォルダ名
    Dim strValue As String      ' CreateFolder()の戻り値
    For Each varValue In varFolders
        ' 上位層からのフォルダパスを作る
        strCurrentPath = strCurrentPath & varValue & "\"
        ' フォルダがあるかチェックする
        On Error Resume Next
        If objFileSystemObject.FolderExists(strCurrentPath) = False Then
            ' フォルダがなかったら新しく作る
            strValue = objFileSystemObject.CreateFolder(strCurrentPath)
        End If
        ' エラーをチェックする
        If Err <> 0 Then
            ' フォルダの作成に失敗したらFor文を終了する
           ' MsgBox "フォルダの作成に失敗しました"
            Exit For
        End If
    Next
 
    ' 使い終わったら必ずNothingを設定する
    Set objFileSystemObject = Nothing
 
End Function

 

 

音声ルーチンは蛇足のような気がするので削除して良いかもしれません(入れたのは単なる趣味です)
ただ動的な内容を変数に入れておけばそれを喋ってくれますので色々応用は利くかと

 

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。

文字を入力するとPCが喋ってくれるVBS

tooljp.com

'http://tooljp.com/CommandBank/Windows/Speak/PC-speak.html
'文字を読み取りPCに喋らせる
Dim Message, Speak
Message=InputBox("PCに喋らせる文字を入力してください。","Speak")

if len(Message)>0 then
  Set Speaker=CreateObject("sapi.spvoice")
  Speaker.Rate = -2
  Speaker.Volume = 100

  Speaker.Speak Message
end if
Set Speaker = Nothing

 

このサイトに掲載のスクリプト・手順など全ての情報については、一切の保証が無いものとしてご利用下さい。PCの不具合、動作、データの破損などについて責任を負うことはできません。あくまでも自己責任となります。