testページ4

Sub 補助移動する()

Sheets("補助").Select
Call 送信元取得

End Sub

---

Sub 文字列置換マクロ()
Dim ws As Worksheet
Dim searchValue As String
Dim replaceValue As String
Dim rng As Range
Dim cell As Range
Dim startPos As Long
Dim foundPos As Long

' アクティブなシートを取得
Set ws = ThisWorkbook.Sheets("補助")

' 置換する文字列と置換後の文字列を取得、置換する範囲を指定
searchValue = ws.Range("I1").Value
replaceValue = ws.Range("I2").Value
Set rng = ws.Range("A6, A9:Z10000")

' 各セルを走査して置換を実行
For Each cell In rng
    startPos = 1
    Do
        foundPos = InStr(startPos, cell.Value, searchValue, vbTextCompare)
        If foundPos > 0 Then
            cell.Value = Left(cell.Value, foundPos - 1) & replaceValue & Mid(cell.Value, foundPos + Len(searchValue))
            startPos = foundPos + Len(replaceValue)
        Else
            Exit Do
        End If
    Loop
Next cell

End Sub

---

Option Explicit

Declare PtrSafe Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub 単語登録()
‘注意！Microsoft Forms 2.0 Object Libarayの参照設定が必要
‘⇒ユーザーフォームを挿入で代用可。

Dim selectedRange As Range
Dim var1 As String, var2 As String
Dim hwnd As LongPtr

Set selectedRange = Selection

If selectedRange.Cells.Count < 2 Then MsgBox "選択されたセルの数が2個未満です。2つのセルを選択してください。", vbExclamation: Exit Sub

var1 = selectedRange.Cells(1).Text
var2 = selectedRange.Cells(2).Text

Shell "C:\Windows\System32\IME\IMEJP\IMJPDCT.EXE", vbNormalFocus
hwnd = FindWindow(vbNullString, "単語の登録")

If hwnd <> 0 Then
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText var2
        .PutInClipboard
        SendKeys "^{v}", True
        SendKeys "{TAB}", True
        Application.Wait (Now + TimeValue("0:00:01"))
        .SetText var1
        .PutInClipboard
        SendKeys "^{v}"
    End With
End If

End Sub