EXCELで、セルに記述したパスから画像を呼び出すマクロを作成中なのですが、絶対パス(例えばC:\Documents and Settings\t06\デスクトップ\test\pic\test1.jpgのような記述)では動作し、その画像が表示されるのですが、相対パス(例えば\pic\test1.jpgのような記述)では動作しませんでした。相対パスで表示する方法はございませんでしょうか?ご教示の程、宜しくお願い申し上げます。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2007/03/14 11:04:46
  • 終了:2007/03/14 14:28:15

ベストアンサー

id:llusall No.1

llusall回答回数505ベストアンサー獲得回数612007/03/14 11:20:48

ポイント27pt

Application.Pathを使って

絶対パスにしてから処理をすればよろしいかと思います。


Option Explicit

Public Sub Test()


    Dim imgPath As String

    imgPath = "\pic\test1.jpg" 'セルから取得したと仮定

    

    

    Dim imgFullPath As String

    imgFullPath = Application.Path & imgPath '絶対パス

    

    

    '---------------------------------

    '絶対パスを使って処理する---------

    '---------------------------------

    Call 画像を呼び出すマクロ(imgFullPath)


End Sub

id:ion10

早々にご返答頂きまして誠にありがとうございます。更に質問させて頂きます。

論理は理解できたのですが、全くの初心者なもので、どのように組み込んでいいのかが良くわからないのです。

作っているものはフォームです。フォームのimageコントロール上に、Excelのセル上の絶対パスから画像を読み込み、スクロールバーで写真が変わるようにはできました。それをいかに相対パスで組み込めるようにできるでしょうか。以下、ソースを記述いたします。

Option Explicit

Private Sub cmd写真選択_Click()

Dim myFD As FileDialog

Set myFD = Application.FileDialog( _

msoFileDialogOpen)

With myFD

.Filters.Add "JPEG", "*.jpg;*.jpeg", 1

.FilterIndex = 1

.AllowMultiSelect = False

If .Show = -1 Then

lblパス.Caption = .SelectedItems(1)

img写真.Picture = _

LoadPicture(.SelectedItems(1))

End If

End With

Set myFD = Nothing

End Sub



Private Sub cmd書き込み_Click()

Dim r As Integer

r = scr切り替え.Value + 3

Cells(r, 1).Value = txt会社名.Text

Cells(r, 2).Value = txt部署名.Text

Cells(r, 3).Value = txt役職名.Text

Cells(r, 4).Value = txt名前.Text

Cells(r, 5).Value = txt〒.Text

Cells(r, 6).Value = txt住所1.Text

Cells(r, 7).Value = txt住所2.Text

Cells(r, 8).Value = txtTEL.Text

Cells(r, 9).Value = txt携帯電話.Text

Cells(r, 10).Value = txtFAX.Text

Cells(r, 11).Value = txtEmail.Text

Cells(r, 12).Value = txturl.Text

Cells(r, 13).Value = txt自宅住所.Text

Cells(r, 14).Value = lblパス.Caption

Call スクロールバー更新

End Sub

Private Sub cmd閉じる_Click()

Unload Me

End Sub


Private Sub img写真_Click()



End Sub

Private Sub lblパス_Click()

End Sub

Private Sub scr切り替え_Change()

Call 読み込み(scr切り替え.Value + 3)

Call スクロールバー更新

End Sub

Private Sub UserForm_Initialize()

Call 読み込み(4)

Call スクロールバー更新

End Sub

Sub 読み込み(r As Integer)

txt会社名.Text = Cells(r, 1).Value

txt部署名.Text = Cells(r, 2).Value

txt役職名.Text = Cells(r, 3).Value

txt名前.Text = Cells(r, 4).Value

txt〒.Text = Cells(r, 5).Value

txt住所1.Text = Cells(r, 6).Value

txt住所2.Text = Cells(r, 7).Value

txtTEL.Text = Cells(r, 8).Value

txt携帯電話.Text = Cells(r, 9).Value

txtFAX.Text = Cells(r, 10).Value

txtEmail.Text = Cells(r, 11).Value

txturl.Text = Cells(r, 12).Value

txt自宅住所.Text = Cells(r, 13).Value

img写真.Picture = _

LoadPicture(Cells(r, 14).Value)

lblパス.Caption = Cells(r, 14).Value

End Sub

Sub スクロールバー更新()

scr切り替え.Max = _

Range("A3").CurrentRegion.Rows.Count

If scr切り替え.Value = scr切り替え.Max Then

lbl件数.Caption = "新規"

Else

lbl件数.Caption = scr切り替え.Value _

& " / " & scr切り替え.Max - 1

End If

End Sub

※コメントがなくてすみません。



また画像のパスを記述するセルの列には更に、1000件ほど相対パスを記述するのですが、その場合imgPathはどのようになるのでしょうか?

何卒、よろしくお願い申し上げます。

2007/03/14 12:32:09

その他の回答(2件)

id:llusall No.1

llusall回答回数505ベストアンサー獲得回数612007/03/14 11:20:48ここでベストアンサー

ポイント27pt

Application.Pathを使って

絶対パスにしてから処理をすればよろしいかと思います。


Option Explicit

Public Sub Test()


    Dim imgPath As String

    imgPath = "\pic\test1.jpg" 'セルから取得したと仮定

    

    

    Dim imgFullPath As String

    imgFullPath = Application.Path & imgPath '絶対パス

    

    

    '---------------------------------

    '絶対パスを使って処理する---------

    '---------------------------------

    Call 画像を呼び出すマクロ(imgFullPath)


End Sub

id:ion10

早々にご返答頂きまして誠にありがとうございます。更に質問させて頂きます。

論理は理解できたのですが、全くの初心者なもので、どのように組み込んでいいのかが良くわからないのです。

作っているものはフォームです。フォームのimageコントロール上に、Excelのセル上の絶対パスから画像を読み込み、スクロールバーで写真が変わるようにはできました。それをいかに相対パスで組み込めるようにできるでしょうか。以下、ソースを記述いたします。

Option Explicit

Private Sub cmd写真選択_Click()

Dim myFD As FileDialog

Set myFD = Application.FileDialog( _

msoFileDialogOpen)

With myFD

.Filters.Add "JPEG", "*.jpg;*.jpeg", 1

.FilterIndex = 1

.AllowMultiSelect = False

If .Show = -1 Then

lblパス.Caption = .SelectedItems(1)

img写真.Picture = _

LoadPicture(.SelectedItems(1))

End If

End With

Set myFD = Nothing

End Sub



Private Sub cmd書き込み_Click()

Dim r As Integer

r = scr切り替え.Value + 3

Cells(r, 1).Value = txt会社名.Text

Cells(r, 2).Value = txt部署名.Text

Cells(r, 3).Value = txt役職名.Text

Cells(r, 4).Value = txt名前.Text

Cells(r, 5).Value = txt〒.Text

Cells(r, 6).Value = txt住所1.Text

Cells(r, 7).Value = txt住所2.Text

Cells(r, 8).Value = txtTEL.Text

Cells(r, 9).Value = txt携帯電話.Text

Cells(r, 10).Value = txtFAX.Text

Cells(r, 11).Value = txtEmail.Text

Cells(r, 12).Value = txturl.Text

Cells(r, 13).Value = txt自宅住所.Text

Cells(r, 14).Value = lblパス.Caption

Call スクロールバー更新

End Sub

Private Sub cmd閉じる_Click()

Unload Me

End Sub


Private Sub img写真_Click()



End Sub

Private Sub lblパス_Click()

End Sub

Private Sub scr切り替え_Change()

Call 読み込み(scr切り替え.Value + 3)

Call スクロールバー更新

End Sub

Private Sub UserForm_Initialize()

Call 読み込み(4)

Call スクロールバー更新

End Sub

Sub 読み込み(r As Integer)

txt会社名.Text = Cells(r, 1).Value

txt部署名.Text = Cells(r, 2).Value

txt役職名.Text = Cells(r, 3).Value

txt名前.Text = Cells(r, 4).Value

txt〒.Text = Cells(r, 5).Value

txt住所1.Text = Cells(r, 6).Value

txt住所2.Text = Cells(r, 7).Value

txtTEL.Text = Cells(r, 8).Value

txt携帯電話.Text = Cells(r, 9).Value

txtFAX.Text = Cells(r, 10).Value

txtEmail.Text = Cells(r, 11).Value

txturl.Text = Cells(r, 12).Value

txt自宅住所.Text = Cells(r, 13).Value

img写真.Picture = _

LoadPicture(Cells(r, 14).Value)

lblパス.Caption = Cells(r, 14).Value

End Sub

Sub スクロールバー更新()

scr切り替え.Max = _

Range("A3").CurrentRegion.Rows.Count

If scr切り替え.Value = scr切り替え.Max Then

lbl件数.Caption = "新規"

Else

lbl件数.Caption = scr切り替え.Value _

& " / " & scr切り替え.Max - 1

End If

End Sub

※コメントがなくてすみません。



また画像のパスを記述するセルの列には更に、1000件ほど相対パスを記述するのですが、その場合imgPathはどのようになるのでしょうか?

何卒、よろしくお願い申し上げます。

2007/03/14 12:32:09
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/03/14 12:10:49

ポイント27pt

相対パス というからには、どこから相対というのがあると思います。

いずれにせよ絶対パスに直す(もしくはカレントディレクトリを変更する)必要があると思いますが、


A1 が \pic\test1.jpg であれば、


マクロを実行している現在の EXCEL のファイル位置からの相対(下階層)にあるのであれば、

    filePath = ThisWorkbook.Path & Range("A1").Value

デスクトップから相対なら、

    Dim deskTopPath As String
    deskTopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    filePath = deskTopPath & Range("A1").Value

となります。

デスクトップパス

id:ion10

どうもありがとうございました。解決いたしました。

2007/03/14 14:26:27
id:hyoga_h No.3

hyoga_h回答回数23ベストアンサー獲得回数02007/03/14 13:27:13

ポイント26pt

http://q.hatena.ne.jp/list

ちょっと気になったのですが、

相対パス指定の場合は

\pic\test1.jpg

ではなく

.\pic\test1.jpg

と先頭にドット(.)をつけるのではないでしょうか?

ただしエクセルなどの場合カレントパスはファイルの置いてある場所ではなくファイルを開くや保存などで最後にアクセスした場所になると思います。

マクロ詳しくないので間違ってたらすいません。

id:ion10

どうもありがとうございます。解決いたしました。

2007/03/14 14:26:34
  • id:llusall
    すみません。m(..)m
    うっかり間違えました。

    「Application.Path」× excel.exe の場所

    「ThisWorkbook.Path」○ 開いているワークブックの場所

    です。
    Mook さんが正しいです。
  • id:Mook
    どのように解決されたか、気になるところですね。

    回答にコメントされた、コードからは相対参照に関連する部分が見当たりませんでしたので、そもそも今回の質問が目的とされる内容とことなっていたのでしょうか。

    興味本位ながら、解決の状況がご報告されるとすっきりするのですが。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません