[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『セル内のリンクを開くショートカットキーは?』(kei)
セル内のリンクからオーディオファイルを開く作業が大量にあり、いちいちマウスに持ち変えるのが面倒なのでキーボードで操作したいのですが。
2010ではデフォルトでそういったキーは無いようで、検索したら「VBAでマクロを設定する」というのを見つけたのですが、うまくいきませんでした。
何かいい方法はありませんでしょうか?
< 使用 Excel:Excel2010、使用 OS:Windows7 >
こういうことでしょうか?
CreateObject("Shell.Application").ShellExecute ActiveCell.Hyperlinks(1).Address
これをショートカットキーに割りつけてやればいいと思います。 (カリーニン) 2014/10/25(土) 22:58
ショートカットキーの割り付けの方法です。
標準モジュール、ThisWorkbookモジュールに↓のコードを記述して保存します。 次回ブック起動時にショートカットキーが有効になります。 ※Ctrl+Alt+Mの同時押しの例です。
'標準モジュール
Sub kidou() CreateObject("Shell.Application").ShellExecute ActiveCell.Hyperlinks(1).Address End Sub
'ThisWorkbookモジュール
Private Sub Workbook_Open() Application.OnKey "^%m", "kidou" End Sub (カリーニン) 2014/10/25(土) 23:05
↑の私のコードではHYPERLINK関数の場合はエラーになりました。 修正版ができましたらアップします。 (カリーニン) 2014/10/25(土) 23:10
標準モジュールのコードを↓に置き換えてください。
Sub kidou() Dim sp As Variant Dim mypath As String Dim c As Range Set c = ActiveCell Err.Clear On Error Resume Next mypath = c.Hyperlinks(1).Address If Err.Number = 9 Then If c.Formula Like "=HYPERLINK(" & """" & "*" Then sp = Split(c.Formula, """") mypath = sp(1) Erase sp Else Exit Sub End If End If On Error GoTo 0 CreateObject("Shell.Application").ShellExecute mypath Set c = Nothing End Sub (カリーニン) 2014/10/25(土) 23:34
ハイパーリンクが設定されたセルがアクティブの状態で Ctrlキー、Altキー、Mキーを同時押ししてますでしょうか? (カリーニン) 2014/10/26(日) 01:01
↓のように起動を確認するMsgBoxを表示するようにして試してみてください。 これでMsgBoxが表示されないようでしたらマクロが動作していないということになります。 ※今日はこれから就寝しますので明日の朝8時ごろまで書き込みができません。
'ThisWorkbookモジュール Private Sub Workbook_Open() Application.OnKey "^%m", "kidou" MsgBox "ThisWorkbook" End Sub
'標準モジュール Sub kidou() Dim sp As Variant Dim mypath As String Dim c As Range Set c = ActiveCell Err.Clear On Error Resume Next mypath = c.Hyperlinks(1).Address If Err.Number = 9 Then If c.Formula Like "=HYPERLINK(" & """" & "*" Then sp = Split(c.Formula, """") mypath = sp(1) Erase sp Else Exit Sub End If End If On Error GoTo 0 CreateObject("Shell.Application").ShellExecute mypath Set c = Nothing MsgBox "標準モジュール" End Sub (カリーニン) 2014/10/26(日) 01:23
確認なのですが、
>セル内のリンク
ハイパーリンクですよね?
ハイパーリンクだとすると、どのように設定したハイパーリンクでしょう? (カリーニン) 2014/10/26(日) 10:17
他サイトですが参考になると思います。
http://oshiete1.watch.impress.co.jp/qa7994423.html
※未検証です。 (カリーニン) 2014/10/26(日) 20:58
リンク先の 2013-03-15 14:24:39 の回答のコードでは、曲のパスに日本語などの2バイト文字が含まれるとエラーになるようです。 いま改造版を作成中ですのですこしお待ちください。 (カリーニン) 2014/10/26(日) 23:32
↓のコードを標準モジュールに貼り付けてください。
>'曲リストセルの指定 この部分で曲リストが記述されているセル範囲を指定してください。 なお、曲はフォルダパスの部分を除いた部分がセルに記述されているとの前提です。
ブックと曲ファイルを同じフォルダ内に格納してあるとの前提です。
Sub test()
'Windows Media Playerのパス指定/定数(環境に合わせて適宜変更) Const pathWMP As String = """C:\Program Files\Windows Media Player\wmplayer.exe""" Dim pathPlayList As String Dim PlayListstr As String Dim fol As String Dim r As Range Dim c As Range Dim kyokupath As String Dim kyokuary() As Variant Dim kyokucnt As Integer Dim i As Integer Dim ima As String 'フォルダの指定(ブックが格納されているフォルダ) fol = ThisWorkbook.Path ima = Format(Now, "yymmdd_hhmmss") 'PlayListのパス指定/適宜変更 pathPlayList = "H:\Music\Playlists\" & Format(Now, "yymmdd_hhmmss") & ".wpl" '曲リストセルの指定 Set r = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(4, 1)) kyokucnt = -1 '曲リストセルをループ For Each c In r '曲パス指定 kyokupath = fol & "\" & c.Value '存在する曲パスだったら If Dir(kyokupath) <> "" Then '変数カウントアップ kyokucnt = kyokucnt + 1 '配列の拡張 ReDim Preserve kyokuary(kyokucnt) '配列に曲パス格納 kyokuary(kyokucnt) = kyokupath End If Next c 'PlayListの文字列作成(前半) PlayListstr = "<?wpl version=""1.0""?>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & "<smil>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " <head>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & "<meta name=" & """" & "Generator" & """" & " content=" & """" & "Microsoft Windows Media Player --11.0.6002.18311" & """" & "/>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & "<meta name=" & """" & "ItemCount" & """" & " content=" & """" & kyokucnt + 1 & """" & "/>" & """" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " <title>" & "My曲リスト" & "</title>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " </head>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " <body>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " <seq>" '配列に格納してある曲パスをPlayListに追加 For i = 0 To kyokucnt PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " <media src=""" & kyokuary(i) & """/>" Next i 'PlayListの文字列作成(後半) PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " </seq>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & " </body>" PlayListstr = PlayListstr & vbCrLf PlayListstr = PlayListstr & "</smil>" 'PlayList作成 Call txtsakusei(pathPlayList, PlayListstr) Erase kyokuary 'Windows Media PlayerにPlayListを与えて起動 Shell (pathWMP & pathPlayList) End Sub
'Unicode形式テキストファイル作成Function
Function txtsakusei(ByVal txtpath As String, txtstr As String)
Const adTypeText = 2 Const adSaveCreateOverWrite = 2 ' adSaveCreateNotExist = 1 Const adWriteLine = 1 '最後に改行を入れる Const adWriteChar = 0 '最後に改行を入れない With CreateObject("ADODB.Stream") .Open .Type = adTypeText .Charset = "Unicode" .WriteText txtstr, adWriteChar .SaveToFile txtpath, adSaveCreateOverWrite .Close End With End Function (カリーニン) 2014/10/27(月) 00:06
Playlistは再生終了後も残りますので適宜削除してください。 (カリーニン) 2014/10/27(月) 00:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.