Results of 1 - 1 of about 6614 for リンク (0.004 sec.)
- [[20070213141159]]
- #score: 3108
- @digest: 490e038f4405e2453d5013746e6054c7
- @id: 28669
- @mdate: 2007-02-23T09:10:39Z
- @size: 11756
- @type: text/plain
- #keywords: hlink (109670), sentaku (107262), lngans (80655), objsfld (43608), hadd (38104), 更") (34784), 止", (33605), strfname2 (29523), objfls (29523), strfname1 (29523), hllink (29072), vbdefaultbutton1 (27752), myfiles (23524), myfsys (22142), vbyesnocancel (20760), chr (20290), へ" (14096), イパ (13705), vbcancel (13157), え: (12068), ーリ (11924), ハイ (9808), 更() (9762), い: (9540), myfld (8865), パー (8743), ル: (7129), ル(* (6820), 中止 (6408), filename (6377), リン (5546), ンク (5446)
- 『ハイパーリンクのリンク先のフォルダを一括置換したい』（ちぃ）
Excel2003(XP) です。 ハイパーリンクのリンク先に、pdfファイルを設定しています。 例えば、以下のように、リンク先のフォルダを変更した場合、 変更前 変更後 リンク先←フォルダ名 リンク先←フォルダ名 | | |- 1.pdf -2006 |- 2.pdf | | - 3.pdf | -1.pdf : | -2.pdf -2007 | -3.pdf : この場合、セルを1つずつ「ハイパーリンクの編集」で フォルダを新しいフォルダに変更していかなければいけないでしょうか? ハイパーリンクされた全てのセルを一括置換できないでしょうか? なお、マクロ・関数はものすごい凝った物でないならわかります。 すみませんが、まことによろしくお願いします。 ---- Sub TEST20070213_3() Rem ハイパーリンクの変更 Dim hlLink As Hyperlink Dim strFname1 As String, strFname2 As String Dim lngAns As Long For Each hlLink In ActiveSheet.Cells.Hyperlinks Do hlLink.Range.Select strFname1 = hlLink.Address strFname2 = Application.GetOpenFilename("PDFファイル (*.pdf),*.pdf", , strFname1) lngAns = MsgBox(strFname1 & Chr(10) & Chr(10) & _ "へのリンクを" & Chr(10) & Chr(10) & _ strFname2 & Chr(10) & Chr(10) & _ "に置き換えます。" & Chr(10) & "よろしいですか?" & Chr(10) & Chr(10) & _ "はい:置き換え" & Chr(10) & Chr(10) & _ "いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ "キャンセル:ファイル選択に戻る", vbYesNoCancel) Loop While lngAns = vbCancel If lngAns = vbYes Then hlLink.Address = strFname2 Next hlLink End Sub あまり労力に差がないかも（汗） (みやほりん)(-_∂)b ---- ありがとうございます。 参考になりました。m(._.)m 書いてくださったマクロを参考に いろいろやってみましたが、あまり労力に差がないかもしれません。 しかし、単純なフォルダ名の変更・追加であるならば マクロが楽そうです。 ありがとうございました。 ---- みやほりんさんのコメントを参考に作ってみました。 質問したちぃです。 Sub ハイパーリンク先のフォルダを変更() Dim hlink As Hyperlink Dim FileName As String For Each hlink In ActiveSheet.Hyperlinks hlink.Range.Select With hlink hadd = .Address End With Sentaku = MsgBox(hadd & Chr(10) & Chr(10) & _ "へのハイパーリンクを置き換えますか?" & Chr(10) & Chr(10) & _ Chr(10) & Chr(10) & _ " はい:置き換えるためファイルを選ぶ" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "ハイパーリンクの変更") If Sentaku = vbCancel Then Exit Sub If Sentaku = vbNo Then GoTo A FileName = Application.GetOpenFilename("PDF ファイル(*.pdf),*.pdf") If FileName = "False" Then Exit Sub lngAns = MsgBox(hadd & Chr(10) & Chr(10) & _ " へのハイパーリンクを" & Chr(10) & Chr(10) & _ FileName & Chr(10) & Chr(10) & _ " に置き換えます。 よろしいですか?" & Chr(10) & Chr(10) & Chr(10) & _ " はい:置き換え" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbExclamation, "ハイパーリンクの変更") If lngAns = vbYes Then hlink.Address = FileName If lngAns = vbCancel Then Exit Sub A: Next hlink End Sub ---- がんばってますね。 If Sentaku = vbNo Then GoTo A 〜 A: は If Sentaku = vbYes Then 〜 End If でもよいかもしれません。 もう一つサンプルを作ってみました。 Sub TEST20070214() Rem ファイルリスト作成 Const myPath = "C:¥temp" Dim myFsys As Object, myFld As Object, mySF As Object, _ myFiles As Object, objfls As Object, objsfld As Object Dim i As Long i = 1 Set myFsys = CreateObject("Scripting.FileSystemObject") Set myFld = myFsys.GetFolder(myPath) Set myFiles = myFld.Files For Each objfls In myFiles Cells(i, 1).Value = objsfld.Path & "¥" & objfls.Name i = i + 1 Next objfls Set mySF = myFld.SubFolders For Each objsfld In mySF Set myFiles = objsfld.Files For Each objfls In myFiles Cells(i, 1).Value = objsfld.Path & "¥" & objfls.Name i = i + 1 Next Next objsfld Set myFiles = Nothing Set mySF = Nothing Set myFld = Nothing Set myFsys = Nothing End Sub C:¥tempというフォルダ、及びその直下のサブフォルダ（一階層）の ファイルリストを作成します。作成したリストを元にHYPERLINK関数で ハイパーリンクを作成するのも良いかもしれません。 (みやほりん)(-_∂)b ---- ありがとうございます。 ＞If Sentaku = vbYes Then 〜 End If でもよいかもしれません。 お〜その手がありましたね。 ということで改定第2弾ですが、まだ GoTo が取れません。 GoTo を無くすにはどうしたらいいか、お分かりでしょうか? Sub ハイパーリンク先を変更() Dim hlink As Hyperlink Dim FileName As String For Each hlink In ActiveSheet.Hyperlinks hlink.Range.Select With hlink hadd = .Address End With A: Sentaku = MsgBox(hadd & Chr(10) & Chr(10) & _ "へのハイパーリンクを置き換えますか?" & Chr(10) & Chr(10) & _ Chr(10) & Chr(10) & _ " はい:置き換えるためファイルを選ぶ" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "ハイパーリンクの変更") If Sentaku = vbCancel Then Exit Sub If Sentaku = vbYes Then FileName = Application.GetOpenFilename("PDF ファイル(*.pdf),*.pdf") If FileName = "False" Then GoTo A lngAns = MsgBox(hadd & Chr(10) & Chr(10) & _ " へのハイパーリンクを" & Chr(10) & Chr(10) & _ FileName & Chr(10) & Chr(10) & _ " に置き換えます。 よろしいですか?" & Chr(10) & Chr(10) & Chr(10) & _ " はい:置き換え" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbExclamation, "ハイパーリンクの変更") If lngAns = vbCancel Then Exit Sub If lngAns = vbYes Then hlink.Address = FileName hlink.Range.Font.Bold = True End If End If Next hlink End Sub ---- ちぃさん、ごめんなさい、すっかり見落としてしまったようです。 もうしわけありません。ずいぶん間が空いてしまいましたので見てくれていると良いのですが。 Sub ハイパーリンク先を変更() Dim hlink As Hyperlink Dim FileName As String For Each hlink In ActiveSheet.Hyperlinks hlink.Range.Select With hlink hadd = .Address End With Do Sentaku = MsgBox("" & Chr(10) & Chr(10) & _ "へのハイパーリンクを置き換えますか?" & Chr(10) & Chr(10) & _ Chr(10) & Chr(10) & _ " はい:置き換えるためファイルを選ぶ" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "ハイパーリンクの変更") If Sentaku = vbCancel Then Exit Sub FileName = Application.GetOpenFilename("PDF ファイル(*.pdf),*.pdf") Loop While FileName = "False" If Sentaku = vbYes Then lngAns = MsgBox(hadd & Chr(10) & Chr(10) & _ " へのハイパーリンクを" & Chr(10) & Chr(10) & _ FileName & Chr(10) & Chr(10) & _ " に置き換えます。 よろしいですか?" & Chr(10) & Chr(10) & Chr(10) & _ " はい:置き換え" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbExclamation, "ハイパーリンクの変更") If lngAns = vbCancel Then Exit Sub If lngAns = vbYes Then hlink.Address = FileName hlink.Range.Font.Bold = True End If End If Next hlink End Sub (みやほりん)(-_∂)b ---- ありがとうございます。見てますよ〜(^^)/ コメントを参考にした後、 さらに、 1.If Sentaku = vbNo の行を付け加え、 2.もともと太字になっているのならそのセルはスキップする ようにしました。 つまり、結局、以下のようなマクロで落ち着きました。 Sub ハイパーリンク先を変更() Dim hlink As Hyperlink Dim FileName As String For Each hlink In ActiveSheet.Hyperlinks If hlink.Range.Font.Bold = False Then '05行目 hlink.Range.Select With hlink hadd = .Address End With Do Sentaku = MsgBox(hadd & Chr(10) & Chr(10) & _ "へのハイパーリンクを置き換えますか?" & Chr(10) & Chr(10) & _ Chr(10) & Chr(10) & _ " はい:置き換えるためファイルを選ぶ" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "ハイパーリンクの変更") If Sentaku = vbCancel Then Exit Sub If Sentaku = vbNo Then Exit Do FileName = Application.GetOpenFilename("PDF ファイル(*.pdf),*.pdf") Loop While FileName = "False" If Sentaku = vbYes Then '21行目 lngAns = MsgBox(hadd & Chr(10) & Chr(10) & _ " へのハイパーリンクを" & Chr(10) & Chr(10) & _ FileName & Chr(10) & Chr(10) & _ " に置き換えます。 よろしいですか?" & Chr(10) & Chr(10) & Chr(10) & _ " はい:置き換え" & Chr(10) & Chr(10) & _ " いいえ:次のリンクへ" & Chr(10) & Chr(10) & _ " キャンセル:中止", vbYesNoCancel + vbDefaultButton1 + vbExclamation, "ハイパーリンクの変更") If lngAns = vbCancel Then Exit Sub If lngAns = vbYes Then '30行目 hlink.Address = FileName hlink.Range.Font.Bold = True End If '30行目を受ける End If '21行目を受ける End If '05行目を受ける Next hlink End Sub です。これにより、数多くのセルにハイパーリンクが設定されていて、 リンクを貼られたファイルが存在するフォルダを変えてしまった場合、 効率よく、リンク先のフォルダを変更していくことが出来るようになりました。 ありがとうございました。（ちぃ）... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200702/20070213141159.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 96999 documents and 607827 words.
訪問者：