Option Explicit

Sub リンク作成()
    
    Dim i As Long
    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        Hyperlinks.Add anchor:=Cells(i, 3), Address:="", SubAddress:="", TextToDisplay:="実行"
    Next
    
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    
    Dim ジャンル As String
    ジャンル = Target.Range.Offset(0, 1).Value
    
    Dim 最初のセル As Range
    Set 最初のセル = Target.Range.Offset(0, 2)
    
    Select Case ジャンル
        Case "フォルダ"
            Call フォルダ(最初のセル)
        Case "Zoom"
            Call Zoom(最初のセル)
    End Select
    
End Sub

Sub フォルダ(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "*無題 - メモ帳"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}")
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    Call ySendKeys("^V")
    Call ySendKeys(" ")
    Call ySendKeys("{TAB}")
    
    Application.CutCopyMode = False
    
End Sub

Sub Zoom(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "Zoom"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}{TAB}{TAB}{TAB}")
    Call ySendKeys(" ")
    Call ySendKeys("{TAB}")
    Call ySendKeys(" ", 2)                          '2秒とめる
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    AppActivate "ミーティングパスコードを入力"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}")
    Call ySendKeys(" ", 5)                          '5秒とめる
    
    Call ySendKeys(" ")
    
    Application.CutCopyMode = False
    
End Sub

Private Function ySendKeys(Keys As String, Optional Time As Double = 0.5, Optional Wait As Boolean = True)
    
    Call Application.SendKeys(Keys, Wait)
    Call Application.Wait([Now()] + Time / 86400)
    
End Function

• Like
• LINE
• Tweet
• Copy URL