[[20141025220737]] 『セル内のリンクを開くショートカットキーは?』(kei) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『セル内のリンクを開くショートカットキーは?』(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

早速ありがとうございます!
…が、
1)各モジュールにいただいたコードをコピペ
2)マクロ有効ブックで保存
3)再度開いて「マクロを有効」に設定
…なのに反応しません。
エラーメッセージは出ないのでこちらがどこかで手順を間違えているんでしょうね。
もう一度試してみます。
(kei) 2014/10/26(日) 00:55

 ハイパーリンクが設定されたセルがアクティブの状態で
 Ctrlキー、Altキー、Mキーを同時押ししてますでしょうか?
(カリーニン) 2014/10/26(日) 01:01

はい。そうしてるんですが…
(kei) 2014/10/26(日) 01:13

 ↓のように起動を確認する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

度々ありがとうございます。
試してみたところやはり作動しないので、なにか根本的に間違ってますねきっと…
マクロをもうちょっと勉強してリトライしてみます。
(kei) 2014/10/26(日) 01:35

 確認なのですが、

 >セル内のリンク

 ハイパーリンクですよね?

 ハイパーリンクだとすると、どのように設定したハイパーリンクでしょう?
(カリーニン) 2014/10/26(日) 10:17

それが他所からもらったファイルなので何とも…なのですが、
要は「大量のwavファイルとエクセルのリストを同じフォルダに入れて、リストの順にwavファイルを再生していく」という作業なのです。
(kei) 2014/10/26(日) 11:08

 他サイトですが参考になると思います。

http://oshiete1.watch.impress.co.jp/qa7994423.html

 ※未検証です。
(カリーニン) 2014/10/26(日) 20:58

試してみます。何度もご教示いただきありがとうございました。
(kei) 2014/10/26(日) 22:49

 リンク先の
 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.