• ベストアンサー

ExcelVBA ファイルを相対パスで関連付けたい

いつもお世話になっています。 Excelで効果音をWAVファイルを鳴らすコードがあります。 このファイルのフルパスを相対パスに変更したいのですが、 どうすればよろしいでしょうか。 よろしくお願いいたします。 Sub sample() Dim SoundFile As String, rc As Long SoundFile = "C:\Users\aaa\Desktop\Sound\boo.wav" rc = mciSendString("Play " & SoundFile, "", 0, 0) End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • moon00
  • ベストアンサー率44% (315/712)
回答No.1

相対パスということは、VBAがあるファイルと同じフォルダにwavファイルが置かれる、ということでしょうか? TmpPath = ThisWorkbook.Path & "\" で現在のフォルダパスを取って、 SoundFile = TmpPath & "boo.wav" としてはいかがですか?

suzupen
質問者

お礼

早々に返答をいただきありがとうございます。 ThisWorkbook.Path & "\" のところまではたどり着いていたのですが 現在のパスを取得してサウンドファイルのパスとつなげるとは。 音が聞こえたときは感動しました!

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • ファイルを開いて1回しか再生されない

    VBAで音楽を鳴らしたいのですが、 ファイルを立ち上げて音楽を鳴らすプロシージャーを一度実行すると、 もう何度F5を押しても実行されません。 しかしファイルを開きなおすとまた実行できます。でも1回限りです。 コードはこちらです。 ------------------------------------------------------------ Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Sub PlaySound() Dim SoundFile As String, rc As Long SoundFile = "C:\【音楽】\test.mp3" If Dir(SoundFile) = "" Then MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation Exit Sub End If SoundFile = Chr(34) & SoundFile & Chr(34) rc = mciSendString("Open " & SoundFile, "", 0, 0) rc = mciSendString("Play " & SoundFile, "", 0, 0) End Sub ------------------------------------------------------------ 2回目実行した際音楽が鳴らないからってファイルがありませんと表示されるわけでもないです。 当方の環境はOSWIN7、OFFICE2007です。 ご回答よろしくお願いします。

  • midi再生について

    visual basicを使ってゲームを作成しております。 あるサイトを見てmidiの再生をやってみようと下記のコードを入力しました。 Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, _ ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, _ ByVal hwndCallback As Long) As Long Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMillsecounds As Long) Sub MCI_Test() Dim P As String, filename As String filename = "sample.mid" P = """" & ActiveWorkbook.Path & "\" & filename & """" Call mciSendString("open " & P & " alias sample", vbNullString, 0, 0) DoEvents Call mciSendString("play sample from 0", vbNullString, 0, 0) Call Sleep(10000) Call mciSendString("close sample", vbNullString, 0, 0) End Sub このコードでfilenameの部分を変更しwavファイルのsample.wavやMP3ファイルのsample.mp3は再生する事ができました。しかし、midiファイルはsample.midを同じフォルダ内に入れているにも関わらず全く音が鳴りません。どこが間違っているのでしょうか。教えてください。宜しくお願い致します。

  • vbaで鳴らした音楽を止めたい

    vbaのAPIで音楽を鳴らした後、 曲が終わる前に、vbaで終了させたいのですが Option Compare Database Option Explicit Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Sub test() Dim mySoundFile As String Dim rc As Long mySoundFile = "C:\tset.mp3" rc = mciSendString("Close " & mySoundFile, "", 0, 0) End Sub これを実行してもエラーにもならないし音楽も鳴り止まないのですが どこがまちがってますか? "C:\tset.mp3"で音楽を再生したので、 "C:\tset.mp3"は存在します。

  • vb6.0でwavファイルの終了を監視する方法について

    お世話になります。 vb6.0でwavファイルを再生するプログラムを作成しております。 下記にコードを記述させていただきます。 Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String _ , ByVal lpstrReturnString As String _ , ByVal uReturnLength As Long _ , ByVal hwndCallback As Long) As Long Private Sub MSComm1_OnComm() '演奏が終了しているか確認 If LCase$(Left$(mciSendString("Status MIDI1 mode", "", 0, 0), 7)) = "stopped" Or _ LCase$(Left$(mciSendString("Status MIDI1 mode", "", 0, 0), 7)) = "0" Then ←(1) Dim ret As Long ret = mciSendString("stop midifile ", "", 0, 0) ret = mciSendString("close midifile", "", 0, 0) ret = mciSendString("open """ & P_PLIST_WARNING & """", "", 0, 0) ret = mciSendString("play """ & P_PLIST_WARNING & """ from 0 wait", "", 0, 0) ret = mciSendString("stop """ & P_PLIST_WARNING & """", "", 0, 0) ret = mciSendString("close """ & P_PLIST_WARNING & """", "", 0, 0) End If End Sub wavファイルを再生するにあたり、まず再生されていない状態を確認してから、再生したいと考えています。 しかしながら、(1)のコードで戻り値が"stopped"または"0"ではなく、"263"で返ってきており、停止を監視できず困っております。 お手数ですが、ご教授いただきたく宜しくお願い申し上げます。

  • VBAでファイルを消したい

    こんばんわ! VBAでエクセルファイルをバックアップしながら使用しているのですが、10個以上ファイルが溜まったら一番古いものを消したいです。 途中まではできているのですが、古いファイルを選択する方法が分かりませんToT 途中までのソースを乗せますので、アドバイスの程よろしくお願いいたします。 ================== Private Sub backup_bot_Click() Dim Path As String, WSH As Variant Dim fc As Long Dim fn As String 'マイドキュメントにバックアップ Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("MyDocuments") & "\test" If Dir(Path, vbDirectory) = "" Then MkDir (Path) End If 'ファイルコピー FileCopy "c:test_date\aaa.xls", Path & "\aaa" & Format(Now, "yyyymmdd") & ".xls" 'ファイル数確認 fn = Dir(Path & "\aaa*.xls") Do While fn <> "" fc = fc + 1 fn = Dir() Loop '10件以上消去 If fc > 10 Then 'ここが分かりません! End If End Sub ================== あ~ちなみにoffice2003エクセルを使用しています。 XP以降のOSで動かしたいです!

  • .xlsファイルが存在するパスを表示させたい

    エクセルマクロ初心者です。 .xlsファイルをサブフォルダも含め検索し、A列にファイル名、B列にファイルが存在するパスを表示させるにはどうしたらいいでしょうか?検索するベースのディレクトリは決まっている”C:\temp”のでtemp以下、.xlsがどこに存在するのかを検索するマクロを組もうとしています。 いろんな書き込みを探し、サブフォルダを含め、ファイル名を取得するものは発見できたので組み込んでみましたが、、パスの表示方法がわかりません。 cnt = 0 Call Sample3("C:\temp") Callでサブルーチンsample3に渡し、ファイル名を取得しています。  Dim cnt As Long Sub Sample3(Path As String) Dim buf As String, f As Object buf = Dir(Path & "\*.xls") Do While buf <> "" cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Loop With CreateObject("Scripting.FileSystemObject") For Each f In .GetFolder(Path).SubFolders Call Sample3(f.Path) Next f End With End Sub あとは、どのように書けばいいのでしょうか? 宜しくお願い致します。

  • 音楽ファイルが再生できない(VBA)

    http://qa.nou-college.net/qa4877134.html の続きですが Sub Sample1() Dim SoundFile As String SoundFile = "C:\Users\Music\サザンオールスターズ/希望の轍.mp3" If Dir(SoundFile) = "" Then MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation Exit Sub End If Shell "mplay32.exe /play /close " & SoundFile End Sub を実行すると「ファイルが見つかりません」となります。 他のMP3ファイルでも同じです。 APIを使う方法なら成功しました。 「MsgBox SoundFile & vbCrLf & "がありません。", 」 とならないのでファイルは見つかっているのだと思います。 何か原因がわかる方よろしくお願いします。

  • ExcelVBAで実行時エラーが出ます

    このようなマクロを作りました。 Sub WriteCsv() Dim myTxtFile As String, myFNo As Integer Dim myLastRow As Long, i As Long Dim j As Long Dim aaa As Worksheet Set aaa = ActiveSheet Application.ScreenUpdating = False j = 0 myTxtFile = ActiveWorkbook.Path & "\Adress List.txt" Worksheets("List").Activate myLastRow = Range("A4").End(xlDown).Row myFNo = FreeFile Open myTxtFile For Output As #myFNo -----※ For i = 4 To myLastRow If Cells(i, 3) = 1 Then Write #myFNo, Cells(i, 5) j = j + 1 End If Next Close #myFNo   ・・・・   ・・・・ このExcelをフォルダーから実行するとすると、※で[ランタイムエラー52]が発生しますが、デスクトップから実行すると出ません。 どのように修正すればいいんでしょうか? よろしくお願いします。

  • エクセル マクロ 相対パスから画像を読み込みたいです。

    エクセル マクロ 相対パスから画像を読み込みたいです。 以前、こちらで同様の質問をして無事に解決していただきました。  ↓ 「エクセル マクロ フルパスから画像を読み込む」(回答番号:No.1) http://okwave.jp/qa/q5527067.html この時は、絶対パスから画像を読み込む方法を教えていただいたのですが、 相対パスでも読み込むようにできるでしょうか (相対パスに変えたら画像が表示されませんでした)。 ‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥ ■表の内容 【Sheet1】…(商品在庫一覧) 【Sheet2】…「印刷用シート」※必要なデータだけをSheet1から呼び出し、印刷用として同じシート上で並べ替える(図では‘行5’から下が印刷範囲です) ‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥ Sheet2のD列(D1~D3‥)に商品画像の「絶対パス」を呼び出しておき、 「写真を配置」のボタンを押すと、印刷範囲の‘行7’のセルに自動で画像が配置されます (‘あ’のパスの画像が‘い’のセルに)。 今までは自分のパソコンのみでこの表を使っていたのですが 他の複数のパソコンでも使用することになり、 絶対パスではフォルダ名(C:\Documents ~)がそれぞれ違うため 相対パスで読み込めたら…と思っています。 ※並び替えなどがあってD列に直接リンクを貼ることができないので、  別に呼び出しておいた「ファイル名」と「C:\Documents ~(格納場所)」を  CONCATENATE関数でくっつけています。 ‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥ ■構文(教えていただいたものをそのまま貼り付けています。すみません) Private Sub photo_1() Const n As Long = 2 'margin Dim r As Range 'Loop用 Dim tr As Range '読み込みセル用 Dim s As String 'セル文字列 Dim X As Double '縦横比固定での縮小率 Dim i As Long With Sheets("【Sheet1】") For Each r In .Range("D1", "D3") s = r.Value If Len(s) = 0 Then Exit For i = i + 1 If Len(Dir(s)) > 0 Then Set tr = .Cells(7, i + 2) With .Pictures.Insert(s).ShapeRange .LockAspectRatio = msoTrue X = Application.Min((tr.Width - n) / .Width, (tr.Height - n) / .Height) .Width = .Width * X .Left = tr.Left + (tr.Width - .Width) / 2 .Top = tr.Top + (tr.Height - .Height) / 2 End With End If Next (-略-) End With '念のためファイルを解放 Dir Application.Path Set tr = Nothing End Sub ‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥‥ どうぞよろしくお願いいたします。

  • フルパスからファイル名取得の方法

    指定したフォルダのフルパスを「bmpFiles」に入れているのですが、表示する時はファイル名のみの表示にしたくて「Path.GetFileName」を使用してファイル名を取得しようとしたのですが、「型'stringの1次元配列'の値を'string'に変換できません」というエラーが出てしまいます。 VBを始めたばかりでよく分からないのでアドバイスをお願いします。 Dim imageDir As String = fbd.SelectedPath ' 指定フォルダまでのディレクトリ Dim bmpFiles As String() = _ System.IO.Directory.GetFiles(imageDir, "*.bmp") 'フルパス Dim bmpFileName As String = _ Path.GetFileName(bmpFiles)  ←bmpFilesで上記エラー