2020/11/18(thu) RelaxTools-Addin Version 4.26.2(RustRemover)

◇バグ修正
・Excelスクショモードで2枚貼付けされる #67 を修正。
　クリップボードからメッセージが来てから500ms待ち時間をした後に貼り付けるようにした。
　待ち時間は設定画面で修正可能とした。
・RelaxTools共通設定で、Excel常駐モードが２重に起動する場合があるのを修正。

Author: RelaxTools

RelaxTools.xlam

@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmScreenSetting 
    Caption         =   "Excelスクショモード設定"
-   ClientHeight    =   2700
+   ClientHeight    =   4080
    ClientLeft      =   45
    ClientTop       =   390
    ClientWidth     =   8400.001
@@ -87,6 +87,7 @@ Private Sub cmdOk_Click()
     Dim lngBlankNum As Long
     Dim blnPageBreakEnable As Boolean
     Dim lngPageBreakNun As Long
+    Dim lngSleep As Long
 
     If chkZoomEnable.Value Then
         If IsNumeric(txtZoomNum.Text) Then
@@ -138,14 +139,29 @@ Private Sub cmdOk_Click()
         txtPageBreakNum.Text = "1"
     End If
 
+    If IsNumeric(txtSleep.Text) Then
+    Else
+        MsgBox "待ち時間には数値を入力してください", vbOKOnly + vbExclamation, C_TITLE
+        txtSleep.SetFocus
+        Exit Sub
+    End If
+    Select Case Val(txtSleep.Text)
+        Case 0 To 99
+        Case Else
+            MsgBox "待ち時間には0～9999を入力してください", vbOKOnly + vbExclamation, C_TITLE
+            txtSleep.SetFocus
+            Exit Sub
+    End Select
+    
     blnZoomEnable = chkZoomEnable.Value
     lngZoomNum = Val(txtZoomNum.Value)
     blnSave = chkSave.Value
     lngBlankNum = Val(txtBlankNum.Value)
     blnPageBreakEnable = chkPageBreakEnable.Value
     lngPageBreakNun = Val(txtPageBreakNum.Value)
+    lngSleep = Val(txtSleep.Value)
 
-    SetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun
+    SetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun, lngSleep
 
     Unload Me
 
@@ -182,8 +198,9 @@ Private Sub UserForm_Initialize()
     Dim lngBlankNum As Long
     Dim blnPageBreakEnable As Boolean
     Dim lngPageBreakNun As Long
+    Dim lngSleep As Long
 
-    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun
+    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun, lngSleep
 
     txtZoomNum.Text = lngZoomNum
     txtBlankNum.Text = lngBlankNum
@@ -192,6 +209,7 @@ Private Sub UserForm_Initialize()
     chkZoomEnable.Value = blnZoomEnable
     chkSave.Value = blnSave
     chkPageBreakEnable.Value = blnPageBreakEnable
+    txtSleep.Value = lngSleep
 
     Call chkZoomEnable_Change
     Call chkPageBreakEnable_Change

Source/src/Form/frmScreenSetting.frm

@@ -69,8 +69,9 @@ Private Sub cmdOk_Click()
     Dim lngBlankNum As Long
     Dim blnPageBreakEnable As Boolean
     Dim lngPageBreakNun As Long
+    Dim lngSleep As Long
 
-    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun
+    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun, lngSleep
 
     If blnSave Then
         If rlxIsFileExists(ActiveWorkbook.FullName) Then

Source/src/Form/frmScreenShot.frm

@@ -795,7 +795,7 @@ End Sub
 '--------------------------------------------------------------
 Public Sub Regident()
     '常駐モード
-    If CBool(GetSetting(C_TITLE, "Option", "RegidentMode", False)) And MultiProcess = False Then
+    If CBool(GetSetting(C_TITLE, "Option", "RegidentMode", False)) And MultiProcess = False And TV Is Nothing Then
         Set TV = New TaskTrayView
         TV.AddIcon Application.hWnd, "Excel常駐モード"
         TV.ShowBalloon "Excel常駐モード" & vbCrLf & "完全に終了させたい場合は、最小化されている空のウィンドウを閉じてください。"

Source/src/Microsoft Excel Objects/ThisWorkbook.cls

@@ -42,6 +42,8 @@ Option Private Module
     Private Declare PtrSafe Function RemoveClipboardFormatListener Lib "user32.dll" (ByVal hWnd As LongPtr) As Long
     Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
 
+    Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
+
 #Else
 
     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
@@ -52,6 +54,7 @@ Option Private Module
     Private Declare Function AddClipboardFormatListener Lib "user32.dll" (ByVal hwnd As Long) As Long
     Private Declare Function RemoveClipboardFormatListener Lib "user32.dll" (ByVal hwnd As Long) As Long
     Private Declare Function GetForegroundWindow Lib "user32" () As Long
+    Private Declare Function GetTickCount Lib "kernel32" () As Long
 
 #End If
 
@@ -75,27 +78,31 @@ Private mlngBlankNum As Long
 Private mblnPageBreakEnable As Boolean
 Private mlngPageBreakNun As Long
 
+Private mlngSleep As Long
+
 Public tray As TaskTrayView
 
 Private WS As Worksheet
-Sub GetScreenSetting(ByRef blnZoomEnable As Boolean, ByRef lngZoomNum As Long, ByRef blnSave As Boolean, ByRef lngBlankNum As Long, ByRef blnPageBreakEnable As Boolean, ByRef lngPageBreakNun As Long)
+Sub GetScreenSetting(ByRef blnZoomEnable As Boolean, ByRef lngZoomNum As Long, ByRef blnSave As Boolean, ByRef lngBlankNum As Long, ByRef blnPageBreakEnable As Boolean, ByRef lngPageBreakNun As Long, ByRef lngSleep As Long)
 
     blnZoomEnable = GetSetting(C_TITLE, "ScreenShot", "ZoomEnable", False)
     lngZoomNum = GetSetting(C_TITLE, "ScreenShot", "ZoomNum", 100)
     blnSave = GetSetting(C_TITLE, "ScreenShot", "Save", False)
     lngBlankNum = GetSetting(C_TITLE, "ScreenShot", "BlankNum", 2)
     blnPageBreakEnable = GetSetting(C_TITLE, "ScreenShot", "PageBreakEnable", False)
     lngPageBreakNun = GetSetting(C_TITLE, "ScreenShot", "PageBreakNum", 1)
+    lngSleep = GetSetting(C_TITLE, "ScreenShot", "Sleep", 500)
 
 End Sub
-Sub SetScreenSetting(ByRef blnZoomEnable As Boolean, ByRef lngZoomNum As Long, ByRef blnSave As Boolean, ByRef lngBlankNum As Long, ByRef blnPageBreakEnable As Boolean, ByRef lngPageBreakNun As Long)
+Sub SetScreenSetting(ByRef blnZoomEnable As Boolean, ByRef lngZoomNum As Long, ByRef blnSave As Boolean, ByRef lngBlankNum As Long, ByRef blnPageBreakEnable As Boolean, ByRef lngPageBreakNun As Long, ByRef lngSleep As Long)
 
     Call SaveSetting(C_TITLE, "ScreenShot", "ZoomEnable", blnZoomEnable)
     Call SaveSetting(C_TITLE, "ScreenShot", "ZoomNum", lngZoomNum)
     Call SaveSetting(C_TITLE, "ScreenShot", "Save", blnSave)
     Call SaveSetting(C_TITLE, "ScreenShot", "BlankNum", lngBlankNum)
     Call SaveSetting(C_TITLE, "ScreenShot", "PageBreakEnable", blnPageBreakEnable)
     Call SaveSetting(C_TITLE, "ScreenShot", "PageBreakNum", lngPageBreakNun)
+    Call SaveSetting(C_TITLE, "ScreenShot", "ScreenShot", lngSleep)
 
 End Sub
 Public Sub StartScreenShot()
@@ -106,15 +113,17 @@ Public Sub StartScreenShot()
     Dim lngBlankNum As Long
     Dim blnPageBreakEnable As Boolean
     Dim lngPageBreakNun As Long
+    Dim lngSleep As Long
 
-    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun
+    GetScreenSetting blnZoomEnable, lngZoomNum, blnSave, lngBlankNum, blnPageBreakEnable, lngPageBreakNun, lngSleep
 
     mblnZoomEnable = blnZoomEnable
     mlngZoomNum = lngZoomNum
     mblnSave = blnSave
     mlngBlankNum = lngBlankNum
     mblnPageBreakEnable = blnPageBreakEnable
     mlngPageBreakNun = lngPageBreakNun
+    mlngSleep = lngSleep
     Set WS = ActiveSheet
 
     mSetHWnd = frmScreenShot.hWnd
@@ -153,15 +162,23 @@ End Sub
 Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
 
     Static bolWndProcCheck As Boolean
+    Static t As LongLong
 
     If Not bolWndProcCheck Then
 
         bolWndProcCheck = True
 
         Select Case uMsg
             Case WM_CLIPBOARDUPDATE
-                If IsClipboardFormatAvailable(CF_BITMAP) <> 0 And GetForegroundWindow() <> Application.hWnd Then
-                    Application.OnTime Now, MacroHelper.BuildPath("pasteScreenShot")
+            
+                If t < GetTickCount() Then
+            
+                    t = GetTickCount() + mlngSleep
+                    
+                    If IsClipboardFormatAvailable(CF_BITMAP) <> 0 And GetForegroundWindow() <> Application.hWnd Then
+                        Application.OnTime Now, MacroHelper.BuildPath("pasteScreenShot")
+                    End If
+                
                 End If
         End Select
 
@@ -176,15 +193,24 @@ End Function
 Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
     Static bolWndProcCheck As Boolean
+    Static t As Long
+
 
     If Not bolWndProcCheck Then
 
         bolWndProcCheck = True
 
         Select Case uMsg
             Case WM_CLIPBOARDUPDATE
-                If IsClipboardFormatAvailable(CF_BITMAP) <> 0 And GetForegroundWindow() <> Application.hWnd Then
-                    Application.OnTime Now, MacroHelper.BuildPath("pasteScreenShot")
+            
+                If t < GetTickCount() Then
+            
+                    t = GetTickCount() + mlngSleep
+                        
+                    If IsClipboardFormatAvailable(CF_BITMAP) <> 0 And GetForegroundWindow() <> Application.hWnd Then
+                        Application.OnTime Now, MacroHelper.BuildPath("pasteScreenShot")
+                    End If
+                
                 End If
         End Select
 
@@ -204,6 +230,8 @@ Public Sub pasteScreenShot()
     If WS Is Nothing Then
         tray.ShowBalloon "貼りつけるシートが見つかりません。コピー失敗しました"
     Else
+    
+        Sleep mlngSleep
 
         '画像を張付
         WS.Paste

Source/src/Modules/basScreenShot.bas

@@ -1,4 +1,11 @@
-2020/11/12(thu) RelaxTools-Addin Version 4.26.1(RustRemover) 
+2020/11/18(thu) RelaxTools-Addin Version 4.26.2(RustRemover) 
+◇バグ修正
+・Excelスクショモードで2枚貼付けされる #67 を修正。
+　クリップボードからメッセージが来てから500ms待ち時間をした後に貼り付けるようにした。
+　待ち時間は設定画面で修正可能とした。
+・RelaxTools共通設定で、Excel常駐モードが２重に起動する場合があるのを修正。
+
+2020/11/12(thu) RelaxTools-Addin Version 4.26.1(RustRemover) 
 ◇機能追加
 ・オプションに「Excel常駐モード」を追加。
 　起動時のレスポンス向上のため、ブックをすべて閉じてもExcelを終了しないようにする。