Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3412 / 13644 ツリー ←次へ | 前へ→

【62336】リンク先の変更について 音速ブルー 09/7/10(金) 11:33 質問[未読]
【62339】Re:リンク先の変更について りん 09/7/11(土) 15:32 回答[未読]
【62404】Re:リンク先の変更について 音速ブルー 09/7/17(金) 19:30 お礼[未読]
【62407】Re:リンク先の変更について りん 09/7/20(月) 11:52 発言[未読]

【62336】リンク先の変更について
質問  音速ブルー  - 09/7/10(金) 11:33 -

引用なし
パスワード
   Excel2000です。
Resultsというフォルダの中に、1stというフォルダと、名簿というエクセルファイルがあります。
1stフォルダの中にTotalというエクセルファイルがあり、名簿ファイルのデータがTotalファイルにリンク貼り付けされています。

Resultsフォルダを、移動させると名簿とTotalのリンクが切れてしまうので、自動的にひとつ上の階層の名簿ファイルを読み込ませようとしたのが、以下のコードです。

Sub 接続()
Dim pt as String
Dim cr as string
pt = Thisworkbook.path
ChDir pt
ChDir".."
cr = CurDir
ActiveWorkbook.ChangeLink Name:=cr & "名簿.xls" ,_
Newname:=cr & "名簿.xls" , Type:=xlExcelLinks

特に下から2行目の、Resultsフォルダを移動前の名簿ファイルのパスの指定でうまくいっていないようです。
何か良い方法はないでしょうか?

【62339】Re:リンク先の変更について
回答  りん E-MAIL  - 09/7/11(土) 15:32 -

引用なし
パスワード
   音速ブルー さん、こんにちわ。
>Excel2000です。
>Resultsというフォルダの中に、1stというフォルダと、名簿というエクセルファイルがあります。
>1stフォルダの中にTotalというエクセルファイルがあり、名簿ファイルのデータがTotalファイルにリンク貼り付けされています。

>Resultsフォルダを、移動させると名簿とTotalのリンクが切れてしまうので、自動的にひとつ上の階層の名簿ファイルを読み込ませようとしたのが、以下のコードです。

>ChDir pt
>ChDir".."
>cr = CurDir
>ActiveWorkbook.ChangeLink Name:=cr & "名簿.xls" ,_
>Newname:=cr & "名簿.xls" , Type:=xlExcelLinks
>特に下から2行目の、Resultsフォルダを移動前の名簿ファイルのパスの指定でうまくいっていないようです。
現在のカレントとマクロの記述をしてあるファイルのドライブが一致していないのかもとか、最後にPathSeparatorがついてないのかもとか原因はいろいろと考えられますが。

フォルダの指定はそのまま使えば大丈夫です。
リンク名はオブジェクトから取得するようにしましたが、複数のファイルがリンクしているならば、そこでの分岐も必要になります。
Sub test()
  Dim cr As String, ls As Variant
  With Application
   pt = .ThisWorkbook.Path 'ActiveWorkbookとは別もの?
   ps = .PathSeparator 'だいたいは¥
  End With
  '一つ上のフォルダの名簿.xls
  pt = pt & ps & ".." & ps & "名簿.xls"
  '
  If Dir(pt) = "" Then
   MsgBox "一つ上には該当ファイルなし", vbExclamation
  Else
   With ActiveWorkbook
     ls = .LinkSources(xlExcelLinks)
     If Not IsEmpty(ls) Then
      For i = 1 To UBound(ls)
        .ChangeLink Name:=ls(i), Newname:=pt, Type:=xlExcelLinks
      Next i
     End If
   End With
  End If
End Sub

こんな感じです。

【62404】Re:リンク先の変更について
お礼  音速ブルー  - 09/7/17(金) 19:30 -

引用なし
パスワード
   りん さん

ありがとうございました。
おっしゃるとおり複数のファイルがリンクしていて、その辺りがうまくいきません。
わからないことだらけですが、やってみようと思います。

【62407】Re:リンク先の変更について
発言  りん E-MAIL  - 09/7/20(月) 11:52 -

引用なし
パスワード
   音速ブルー さん、こんにちわ。

>おっしゃるとおり複数のファイルがリンクしていて、その辺りがうまくいきません。

For i = 1 To UBound(ls)
  .ChangeLink Name:=ls(i), Newname:=pt, Type:=xlExcelLinks
(略)

この、ls(i)の内容を調べて分岐したらよいと思います。

3412 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free