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 "エクスプローラ": Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "^V", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Rem コピー2
セル.Offset(0, 1).Copy
Application.SendKeys "^V", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys " ", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{ENTER}", True
Application.CutCopyMode = False
End Sub
Sub Zoom(ByVal セル As Range)
Rem コピー1
セル.Copy
AppActivate "Zoom": Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "^V", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys " ", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys " ", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.Wait [Now() + "00:00:02"] '2秒とめる(PW画面に移るまで時間かかるため)
Rem コピー2
セル.Offset(0, 1).Copy
AppActivate "ミーティングパスコードを入力": Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "^V", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys "{TAB}", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.SendKeys " ", True: Application.Wait [Now() + "00:00:00.5"] '0.5秒とめる
Application.Wait [Now() + "00:00:05"] '5秒とめる(接続に時間がかかるため)
Application.SendKeys " ", True
Application.CutCopyMode = False
End Sub