anonymous セミオートログイン
No License VBA
2021年11月06日
Copy Clone
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
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
フォルダの方は動作未確認
Zoomは確認済み
WaitTimeは適当にチューニングしてください
数値など直接コードに書いてるので変更してください
エラー対応も一切していません(
anonymous
Anonymous
2021年11月06日
Ver.2(SendKeysとWaitを関数化) https://harigami.net/cd?hsh=d1dc3ceb-4502-4005-9627-3bf3909804c6