
No License
VBA
2021年11月06日
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
フォルダの方は動作未確認 Zoomは確認済み WaitTimeは適当にチューニングしてください 数値など直接コードに書いてるので変更してください エラー対応も一切していません( Ver.2 SendKeysとWaitを関数化してコードをすっきりさせました!
No one still commented. Please first comment.