今年最後の配列。
(読んでいる人はいないと思いますが、)皆様、良いお年を。
Private Sub Auto_Close()
With Application
.OnKey "^+c"
.OnKey "^+v"
End With
End Sub
Private Sub Auto_Open()
With Application
.OnKey "^+c", "CopyActiveCellValue"
.OnKey "^+v", "PasteSameValue"
End With
End Sub
Private Sub CopyActiveCellValue()
With Application
.SendKeys "{F2}"
.SendKeys "^{End}"
.SendKeys "^+{Home}"
.SendKeys "^c"
.SendKeys "{Esc}"
.StatusBar = "★アクティブセルの値をコピーしました。"
End With
End Sub
Private Sub PasteSameValue()
With Application
.SendKeys "{BS}"
.SendKeys "^v"
.SendKeys "^{Enter}"
.StatusBar = "★選択セル全てに対し、同じ値を貼り付けました。"
End With
End Sub
Private WithEvents xlApp As Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub xlApp_SheetSelectionChange( _
ByVal Sh As Object, _
ByVal Target As Range _
)
On Error GoTo ErrProc:
Set wf = WorksheetFunction
xlApp.StatusBar = _
" ■合計=" & wf.Subtotal(9, Target) & _
" ■データの個数=" & wf.Subtotal(3, Target)
Exit Sub
ErrProc:
Set e = Err
xlApp.StatusBar = _
" ■" & e.Description & _
" ■エラー番号:" & e.Number
End Sub
Option Explicit
Dim objWshShell
Set objWshShell = WScript.CreateObject("WScript.Shell")
With objWshShell
.Run("D:\日本語入力\月5-315\月5-315_配列図.png")
.Exec("C:\App\hishi121\hishi.exe")
.Exec("C:\App\TWJK214\TWellJK.exe")
End With
Set objWshShell = Nothing
With WScript.CreateObject("WScript.Shell")
.Run("D:\日本語入力\月5-315\月5-315_配列図.png")
.Exec("C:\App\hishi121\hishi.exe")
.Exec("C:\App\TWJK214\TWellJK.exe")
End With