sakuracolor kuro-2.col

'//sakuracolor kuro-2.col

; テキストエディタ色設定 Ver3

[SakuraColor]
C[BRC]=1,1,ffff84,202020,0
C[CAR]=1,0,ff8080,3a3a3a,0
C[CBK]=0,0,f2f8f8,0e1616,0
C[CMT]=1,0,cc9b6a,202020,0
C[CTL]=0,0,c6c6c6,202020,0
C[CVL]=0,0,ffc184,3a3a3a,0
C[DFA]=0,0,202020,ffc184,0
C[DFC]=0,0,202020,c0fdbd,0
C[DFD]=0,0,202020,f2f8f8,0
C[EBK]=0,0,222827,202020,0
C[EOF]=1,0,ff9999,0c0c0c,0
C[EOL]=1,0,c6c6c6,202020,0
C[FN2]=1,0,202020,ffff9e,0
C[FN3]=1,0,202020,9eff9e,0
C[FN4]=1,0,202020,9eceff,0
C[FN5]=1,0,202020,ff9eff,0
C[FND]=1,0,202020,9effff,0
C[HDC]=0,0,84ff84,202020,0
C[IME]=1,0,ff8080,3a3a3a,0
C[KW1]=1,0,ffff84,202020,0
C[KW2]=1,0,84c1ff,202020,0
C[KW3]=1,0,ff84c1,202020,0
C[KW4]=0,0,8484ff,202020,0
C[KW5]=0,0,8484ff,202020,0
C[KW6]=0,0,8484ff,202020,0
C[KW7]=0,0,8484ff,202020,0
C[KW8]=0,0,8484ff,202020,0
C[KW9]=0,0,8484ff,202020,0
C[KWA]=0,0,8484ff,202020,0
C[LNO]=1,0,c6c6c6,3a3a3a,0
C[MOD]=1,1,c6c6c6,3a3a3a,0
C[MRK]=0,0,202020,c08000,0
C[NOT]=0,0,ff9999,f0fbff,0
C[NUM]=0,0,fdfdfd,202020,0
C[PGV]=0,0,f0fbff,ffe6be,0
C[RAP]=1,0,ff9999,202020,0
C[RK1]=1,0,cccc6a,202020,0
C[RK2]=1,0,cccc6a,202020,0
C[RK3]=0,0,cccc6a,202020,0
C[RK4]=0,0,cccc6a,202020,0
C[RK5]=0,0,cccc6a,202020,0
C[RK6]=0,0,cccc6a,202020,0
C[RK7]=0,0,cccc6a,202020,0
C[RK8]=0,0,cccc6a,202020,0
C[RK9]=0,0,cccc6a,202020,0
C[RKA]=0,0,cccc6a,202020,0
C[RUL]=1,0,c6c6c6,3a3a3a,0
C[SEL]=1,0,ff8080,0e1616,0
C[SPC]=1,0,474747,202020,0
C[SQT]=0,0,84ff84,202020,0
C[TAB]=1,0,c6c6c6,202020,0
C[TXT]=1,0,fdfdfd,202020,0
C[UND]=1,0,ffc184,3a3a3a,0
C[URL]=1,0,c184ff,202020,1
C[VER]=0,0,ff9999,202020,0
C[WQT]=1,0,84ff84,202020,0
C[ZEN]=1,0,c6c6c6,202020,0

時間計測 サンプル

Sub Main()
    Dim executionTime As Double
    executionTime = MeasureExecutionTime()
    
    MsgBox "計測完了" & vbLf & "実行時間は" & Format(executionTime, "0.000秒") & "でした"
End Sub
Function MeasureExecutionTime() As Double
    Dim startTime As Double
    startTime = Timer
    
    ' ここに測定したい処理を挿入
    Call AddSheetNamesToLastColumn2
    
    MeasureExecutionTime = Timer - startTime
End Function

Sub AddSheetNamesToLastColumn2()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long

    ' 各シートに対して処理を実行
    For Each ws In ThisWorkbook.Worksheets
        ' 最終行と最終列を取得
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        
        ' タイトル行の一番右の列にシート名を入れる
        ws.Cells(1, lastCol + 1).Value = "シート名"
        
        ' 最終行までシート名をコピー
        ws.Cells(2, lastCol + 1).Resize(lastRow - 1, 1).Value = ws.Name
    Next ws
    
End Sub

処理を分岐

Sub MessagePrompt()
    Dim response As VbMsgBoxResult

    ' メッセージボックスを表示し、ユーザーからの応答を取得します
    response = MsgBox("処理を続行しますか？", vbYesNo + vbQuestion, "確認")

    ' ユーザーがYesを選択した場合の処理
    If response = vbYes Then
        MsgBox "処理を続行します。"
        ' ここにYesを選択した場合の処理を記述します
    Else ' ユーザーがNoを選択した場合の処理
        MsgBox "処理を中止します。"
        ' ここにNoを選択した場合の処理を記述します
    End If
End Sub

time計測

'time計測
Dim ST As Double
ST = Timer

'処理時間の取得
Debug.Print Timer - ST
MsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(Timer - ST, "0.000秒") & "でした"

'//--------------------

Debug.Print Now() & Right(Format(Timer, "0.00"), 3)
Debug.Print Format(Now(), "YYYY/MM/DD HH:MM:SS") & Right(Format(Timer, "0.00"), 3)
Debug.Print [=TEXT(Now(),"yyyy/mm/dd hh:mm:ss.00")]

配列を使用して日付を変換

Sub ConvertDateFormatWithArray()
    Dim lastRow As Long
    Dim dateValues As Variant
    Dim convertedDates() As Variant
    Dim i As Long
    Dim yyyy As String
    Dim mm As String
    Dim dd As String
    
    ' 最終行を取得
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' A列の値を配列に読み込む
    dateValues = Range("A1:A" & lastRow).Value
    
    ' 出力用の配列をリサイズ
    ReDim convertedDates(1 To lastRow, 1 To 1)
    
    ' 配列内の日付を変換
    For i = 1 To UBound(dateValues, 1)
        If Len(dateValues(i, 1)) = 8 Then ' 8桁の場合のみ変換
            yyyy = Left(dateValues(i, 1), 4)
            mm = Mid(dateValues(i, 1), 5, 2)
            dd = Right(dateValues(i, 1), 2)
            convertedDates(i, 1) = yyyy & "/" & mm & "/" & dd
        Else
            convertedDates(i, 1) = dateValues(i, 1) ' 変換不要ならそのままセット
        End If
    Next i
    
    ' 変換した日付をセルに書き戻す
    Range("b1:b" & lastRow).Value = convertedDates
End Sub

'//---------------------------------------------------------------

Sub ConvertDateFormat()
    Dim lastRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim dateString As String
    Dim convertedDate As Date
    Dim resultArray() As Variant
    Dim i As Long
    
    ' 最終行を取得
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 対象のセル範囲を指定（A列の最初のセルから最終行まで）
    Set rng = Range("A1:A" & lastRow)
    
    ' 結果を格納する配列の初期化
    ReDim resultArray(1 To lastRow, 1 To 1)
    
    ' セル範囲内の各セルに対して処理を行う
    For i = 1 To lastRow
        ' セルの値を文字列として取得
        dateString = CStr(rng.Cells(i, 1).Value)
        
        ' 文字列がyyyymmdd形式であるかどうかを確認
        If Len(dateString) = 8 And IsNumeric(dateString) Then
            ' yyyymmdd形式の日付をyyyy/mm/dd形式に変換
            convertedDate = DateSerial(Left(dateString, 4), Mid(dateString, 5, 2), Right(dateString, 2))
            ' 変換した日付を配列に格納
            resultArray(i, 1) = Format(convertedDate, "yyyy/mm/dd")
        Else
            ' エラーまたは無効な日付の場合は元の値をそのまま格納
            resultArray(i, 1) = rng.Cells(i, 1).Value
        End If
    Next i
    
    ' 変換した結果をB列に出力
    rng.Offset(0, 1).Value = resultArray
End Sub

'//------------------------------------------

’配列でないパターン
Sub ConvertDateFormat2()

    Dim rng As Range
    Dim cell As Range
    Dim dateValue As String
    Dim convertedDate As String
    Dim yyyy As String
    Dim mm As String
    Dim dd As String
    
    ' 変換するセル範囲を指定（A列の最終行まで）
    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    ' セル範囲内の各セルに対して処理を行う
    For Each cell In rng
        ' セルの値を文字列として取得
        dateValue = cell.Value
        
        ' yyyymmdd形式の日付をyyyy/mm/dd形式に変換
        If Len(dateValue) = 8 Then ' 8桁の場合のみ処理を行う
            yyyy = Left(dateValue, 4)
            mm = Mid(dateValue, 5, 2)
            dd = Right(dateValue, 2)
            convertedDate = yyyy & "/" & mm & "/" & dd
            
            ' 変換した日付をセルにセット
            cell.Value = convertedDate
        End If
    Next cell
End Sub

バッチファイル内でPowerShellを利用してウィンドウの不透明度を88%に設定

@echo off

set "WindowTitle=MyWindowTitle"
set "Opacity=88"

powershell.exe -Command "$signature='[DllImport(\"user32.dll\")]public static extern bool SetLayeredWindowAttributes(IntPtr hwnd, uint crKey, byte bAlpha, uint dwFlags);';$winapi=Add-Type -MemberDefinition $signature -Name LayeredWindow -Namespace User32 -PassThru; $hwnd=(Get-Process | Where-Object {$_.MainWindowTitle -eq \"%WindowTitle%\"}).MainWindowHandle; $winapi::SetLayeredWindowAttributes($hwnd, 0, (%Opacity% * 255 / 100), 2)"

分岐確認 サンプル

Sub CreateResultFile()

’セルC2が空白でない場合にはCSVファイルが作成し、かつセルC2が空白の場合にはテキストファイルが作成

    Dim searchDate As String
    Dim fileName As String
    Dim filePath As String
    Dim fileContent As String
    Dim ws As Worksheet
    Dim cellC2 As Range

    ' 検索日の取得
    searchDate = Format(Date, "yyyymmdd")

    ' ファイル名の作成
    fileName = "対象なし_" & searchDate

    ' シート1を参照
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' セルC2を参照
    Set cellC2 = ws.Range("C2")

    ' セルC2が空白でない場合
    If cellC2.Value <> "" Then
        ' CSVファイルを作成し保存
        filePath = ThisWorkbook.Path & "\" & fileName & ".csv"
        Open filePath For Output As #1
        Print #1, "セルC2が空白ではありません。"
        Close #1
        MsgBox "CSVファイルが作成されました: " & filePath
    Else
        ' ファイル内容の作成
        fileContent = "検索結果が見つかりませんでした。"

        ' テキストファイルを作成し保存
        filePath = ThisWorkbook.Path & "\" & fileName & ".txt"
        Open filePath For Output As #1
        Print #1, fileContent
        Close #1

        MsgBox "テキストファイルが作成されました: " & filePath
    End If
End Sub

Outlook VBAを使用して、特定の受信メールの添付ファイルを指定したフォルダにダウンロード

'//--------------------------------------------------------

Sub SaveAttachmentsToFolder()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 添付ファイルを保存するフォルダを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            For Each olAttachment In olItem.Attachments
                ' 添付ファイルを保存します
                olAttachment.SaveAsFile saveFolder & olAttachment.fileName
            Next olAttachment
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsFromSpecificSender()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "karkun1118@outlook.jp"
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した送信者からのメールであるかどうかを確認します。
            If olItem.SenderEmailAddress = targetSender Then
                For Each olAttachment In olItem.Attachments
                    ' 添付ファイルを保存します
                    olAttachment.SaveAsFile saveFolder & olAttachment.fileName
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsWithSenderAndDate()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    Dim targetSubject As String
    Dim targetSentDate As Date
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "karkun1118@outlook.jp"
    
    ' 件名に含まれる文字列を指定します。
    targetSubject = "テスト"
    
    ' 指定した送信日を設定します。
    targetSentDate = Date ' 今日の日付を設定します。必要に応じて変更してください。
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した条件に一致するメールのみを処理します。
            If olItem.SenderEmailAddress = targetSender And InStr(1, olItem.Subject, targetSubject, vbTextCompare) > 0 And olItem.SentOn >= targetSentDate Then
                For Each olAttachment In olItem.Attachments
                    ' 送信者の名前と送信日を取得し、ファイル名に追加して保存します。
                    Dim fileName As String
                    fileName = olAttachment.fileName
                    Dim senderName As String
                    senderName = olItem.senderName
                    Dim sentDate As String
                    sentDate = Format(olItem.SentOn, "yyyy-mm-dd") ' 送信日を "yyyy-mm-dd" 形式で取得します
                    Dim savePath As String
                    savePath = saveFolder & senderName & "_" & sentDate & "_" & fileName
                    olAttachment.SaveAsFile savePath
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsWithSenderAndDate()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    Dim targetSubject As String
    Dim targetSentDate As Date
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "C:\Attachments\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "example@example.com"
    
    ' 件名に含まれる文字列を指定します。
    targetSubject = "見積"
    
    ' 指定した送信日を設定します。
    targetSentDate = Date ' 今日の日付を設定します。必要に応じて変更してください。
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した条件に一致するメールのみを処理します。
            If olItem.SenderEmailAddress = targetSender And InStr(1, olItem.Subject, targetSubject, vbTextCompare) > 0 And olItem.SentOn >= targetSentDate Then
                For Each olAttachment In olItem.Attachments
                    ' 送信者の名前と送信日を取得し、ファイル名に追加して保存します。
                    Dim fileName As String
                    fileName = olAttachment.FileName
                    Dim senderName As String
                    senderName = olItem.SenderName
                    Dim sentDate As String
                    sentDate = Format(olItem.SentOn, "yyyy-mm-dd") ' 送信日を "yyyy-mm-dd" 形式で取得します
                    Dim savePath As String
                    savePath = saveFolder & senderName & "_" & sentDate & "_" & fileName
                    olAttachment.SaveAsFile savePath
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

検索結果シートをPDFとして保存

Sub SaveSearchResultAsPDF()
    Dim searchDate As String
    Dim fileName As String
    Dim filePath As String

    ' 検索日の取得
    searchDate = Format(Date, "yyyymmdd")

    ' ファイル名の作成
    fileName = "検索結果_" & searchDate & ".pdf"

    ' ファイルパスの作成（保存先を適切な場所に変更してください）
    filePath = ThisWorkbook.Path & "\" & fileName

    ' PDFとしてシートを保存
    Sheets("検索結果").ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard

    MsgBox "PDFファイルが作成されました: " & filePath
End Sub

検索結果が抽出されなかった場合、テキストファイルを作成し保存する

Sub CreateResultTextFile()
    Dim searchDate As String
    Dim fileName As String
    Dim filePath As String
    Dim fileContent As String

    ' 検索日の取得
    searchDate = Format(Date, "yyyymmdd")

    ' ファイル名の作成
    fileName = "対象なし_" & searchDate & ".txt"

    ' ファイルパスの作成（保存先を適切な場所に変更してください）
    filePath = ThisWorkbook.Path & "\" & fileName

    ' ファイル内容の作成
    fileContent = "検索結果が見つかりませんでした。"

    ' テキストファイルを作成し保存
    Open filePath For Output As #1
    Print #1, fileContent
    Close #1

    MsgBox "テキストファイルが作成されました " & vbNewLine & vbNewLine & fileName
End Sub

タスクスケジューラー 実行するVBSファイルとマクロファイル、マクロ名の設定

■プログラム/スクリプト：VBSファイルパス

Dim excelApp,macro

file = WScript.Arguments(0)
macro = WScript.Arguments(1)

Set excelApp = CreateObject("Excel.Application")

excelApp.Visible = False        'Excelを非表示にする
excelApp.DisplayAlerts = False  'ポップアップメッセージを非表示にする
excelApp.AutomationSecurity = 1 'マクロを有効にする

'Excelファイルを読み取り専用で開く
excelApp.Workbooks.Open file,3,False

WScript.Echo "---マクロを実行します---"

'マクロを実行する
excelApp.Run macro

WScript.Echo "---マクロの実行が完了しました---"

'Excelを終了する
excelApp.Quit

Set excelApp = Nothing

■引数の追加：マクロファイルパス マクロ名を入力

”C:\マクロ\123.xlsm” “Moduleマクロ名”

Excelの起動オプション

起動画面（スプラッシュウィンドウ）を表示しない

”C:\Program Files (x86)\Microsoft Office\root\Office16\EXCEL.EXE” /e

---オプション---
ブックのパス | ファイル名    Excel を起動し、指定されたファイルを開く。  excel.exe "c:\My Folder\book1.xlsx"
/x    Excel の新しいインスタンスを (別プロセスで) 起動。    excel.exe /x "c:\My Folder\book1.xlsx"
/r    指定されたブックを読み取り専用で開く。    excel.exe /r "c:\My Folder\book1.xlsx"
/t    Excel を起動し、指定されたファイルをテンプレートとして開く。    excel.exe /t "c:\My Folder\book_name.xlsx"
/n    /t と同様に Excel を起動し、指定されたファイルをテンプレートとして開く。    excel.exe /n "c:\My Folder\book_name.xlsx"
/e
/embed    Excel が起動画面を表示せず、新しい空のブックも開かないようにする。    excel.exe /e
/p    フォルダーをアクティブな作業フォルダー ([名前を指定して保存] ダイアログ ボックスで表示されるフォルダー) として指定する。    excel.exe /p "c:\My Folder"
/m    単一の XLM マクロ シートを含む新しいブックを作成。    excel.exe /m
/s
/safemode    Excel または Microsoft Office がインストールされているディレクトリ内にある既定の XLStart フォルダーなどのスタートアップ ディレクトリ内に保存されているすべてのファイルが、強制的にスキップされるようにする。    excel.exe /s
/a progID    Excel を起動し、アドインの progID で指定されるオートメーション アドインを読み込む。    excel.exe /a MyProgId.MyProgID2.1

バッチファイルをタスクバーにピン留めする方法

バッチファイルのショットカットのリンク先の先頭に

「cmd.exe /c 」をつけて、適用

※「cmd.exe /c 」のcの後ろには半角スペース

値のみ貼り付け

Sub 値のみ貼り付け()
    ' セルA1をコピー
    Worksheets("Sheet1").Range("A1").Copy
    
    ' セルB1に値のみを貼り付け
    Worksheets("Sheet2").Range("B1").PasteSpecial Paste:=xlPasteValues
    
    ' コピー状態を解除
    Application.CutCopyMode = False
End Sub

 

日付を付けてcsv保存

Sub SaveCSVWithDate()
    Dim savePath As String
    Dim fileName As String
    Dim currentDate As String

    ' 現在の日付を取得し、yyyymmdd形式にフォーマットする
    currentDate = Format(Date, "yyyymmdd")

    ' 保存先のパスを指定する場合
    savePath = "C:\YourFolderPath\" ' 保存したいフォルダのパスに変更してください

    ' 保存先がデスクトップの場合
    ’savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    ' ファイル名を指定
    fileName = "YourFileName_" & currentDate & ".csv" ' "YourFileName"を任意のファイル名に変更してください

    ' ファイルを保存
    ActiveWorkbook.SaveAs Filename:=savePath & fileName, _
        FileFormat:=xlCSV, CreateBackup:=False

    MsgBox "CSVファイルが保存されました。"
End Sub

Sub SaveCSVWithDateToDesktop()
    Dim savePath As String
    Dim fileName As String
    Dim currentDate As String

    ' 現在の日付を取得し、yyyymmdd形式にフォーマットする
    currentDate = Format(Date, "yyyymmdd")

    ' デスクトップのパスを取得する
    savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    ' ファイル名を指定
    fileName = "YourFileName_" & currentDate & ".csv" ' "YourFileName"を任意のファイル名に変更してください

    ' ファイルを保存
    ActiveWorkbook.SaveAs Filename:=savePath & fileName, _
        FileFormat:=xlCSV, CreateBackup:=False

    MsgBox "CSVファイルがデスクトップに保存されました。"
End Sub