[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シート1の図形に入力された文字と、シート2のセルに入力された文字が一致したらハイパーリンクを貼るマクロ』（mogu）
こんにちは、要約のようなマクロを作りたいのですが、ハイパーリンクが上手く貼れません。
以下のvという変数はシェイプオブジェクトが入っているわけではないのでしょうか？
初心者のためどうかアドバイスいただけると助かります。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
A：シート1にある図形(形は様々)、図形のテキスト編集で「x」と入力されている
B：シート2に「x」と入力されたセル
一度実行すれば、シート内にある全ての図形Aに、それぞれ対応するBのセルへのハイパーリンクを貼るようにしたいです。
Sub ShapeLink()
Dim v As Variant
Dim str As String
On Error Resume Next
For Each v In Sheets("シート1").Shapes
'エラー情報を初期化
Err.Clear
str = ""
'strにシート1図形内のテキストを代入
str = v.TextFrame.Characters.Text
'strが空でなければ
If str <> "" Then
'シート2シートのstrの値を持つセルを検索する
Set Rng = Worksheets("シート2").Cells.Find(What:=str, LookIn:=xlValues, LookAt:=xlWhole)
'シート1の図形にシート2のセルへのハイパーリンクを貼る(ここがおかしい？)
v.Hyperlinks.Add Anchor:=Sheets("シート1").v, Address:=Worksheets("シート2").Rng.Address
End If
Next v
'エラーがあれば0に飛ぶ?
On Error GoTo 0
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞
Sheets("シート1").Hyperlinks.Add anchor:=v, Address:="", SubAddress:=Rng.Address(external:=True)
（マナ） 2015/01/31(土) 16:32
>vという変数はシェイプオブジェクトが入っているわけではないのでしょうか？
vという変数は、確かにShapeオブジェクトを指す変数です。使用方法が違うのでしょうねえ
If str <> "" Then
'シート2シートのstrの値を持つセルを検索する
Set Rng = Worksheets("シート2").Cells.Find(What:=str, LookIn:=xlValues, LookAt:=xlWhole)
’ここがおかしい？
↑確かにハイパーリンク設定が間違っています。
v.Hyperlinks.Add Anchor:=Sheets("シート1").v, Address:=Worksheets("シート2").Rng.Address
'v（Shapeオブジェクト）にはHyperlinksを取得する手続きはありません。
'Sheets("シート1").v 、Sheets("シート1")オブジェクトには vという手続きはありません。
'Shapeオブジェクトは、既に vという変数だけで取得できています
' Address:=Worksheets("シート2").Rng.Address これもWorksheets("シート2")オブジェクトには Rngという手続きはありません。
'Rangeオブジェクトは 既に Rngという変数で取得できています。
'セル指定は、Subaddressオプションを使います。
v.Parent.Hyperlinks.Add Anchor:=v, Address:="", SubAddress:=rng.Address(, , , True)
このように変更して見ては いかがですか
End If
（ichinose） 2015/01/31(土) 16:40
ハイパーリンクの設定がどうこうという前に、このコードは、少しリスキーです。
そのシートをアクティブにした状態で以下のコードを走らせてみてください。 テキストが表示されるものと失敗というものがでてくると思います。（もしかしたら、失敗はでないかもしれませんが）
シート上のShapeは、様々な性格の異なるものが【ごった煮】のように配置されている可能性があります。 たとえば、入力規制なんかでリスト表示を設定してあるものもShapeですし、図形ではなく図もShapeです。 今はないかもしれませんが、ActiveXコントロールやフォームツールコントロールもShapeです。 また、図形の中でも、線なんかはテキストを持っていません。
そういったものがあったとき、提示コードでは Errorトラップによりエラーは発生しませんが 具合の悪い処理が行われようとします。
対象にしようとしている図形かどうか、判断しながら進めていく必要があります。 （エラートラップで切り抜けようとするなら、それはそれでいいのですが、提示コードとは異なる記述が必要です）
Sub Test()
Dim shp As Shape
Dim s As String
Dim er As Variant
For Each shp In ActiveSheet.Shapes
er = 0
On Error Resume Next
s = shp.TextFrame.Characters.Text
er = Err.Number
On Error GoTo 0
MsgBox IIf(er = 0, shp.Name & vbLf & s, shp.Name & "失敗")
Next
End Sub
（β） 2015/01/31(土) 16:45
追加で。
Set Rng = Worksheets("シート2").Cells.Find(What:=str, LookIn:=xlValues, LookAt:=xlWhole)
もし、見つからなかったとき、Rng は Nothing になっていおり、対象セルがないわけですので 参照できません。 だけど、提示コードは、それに、お構いなしに、参照しようとします。 （まぁ、ここも、Erroトラップで、エラー発生にはなりませんが）
（β） 2015/01/31(土) 16:49
追伸
変数strの宣言、確かに間違いではありません。
VBAには、Strという関数があります。昔のBasicでは、予約語になっていて、これを変数に使うと エラーになったのですが、今は、関数のVBA内での立場が違うのでエラーには、なりません。
関数にもある名前を変数として使うときは、注意してください。思わぬエラーになるときがあります。
とくに問題がなければ、 Mystr 等と名前を変えるのが良いと思います。
君子 危うきに近寄らず です。
（ichinose） 2015/01/31(土) 16:52
（β） 2015/01/31(土) 16:49 で
そういったものがあったとき、提示コードでは Errorトラップによりエラーは発生しませんが 具合の悪い処理が行われようとします。
このようにレスしましたが、コードをよく読むと、テキストを取得できなかった場合は処理をスキップしている コードでした。
失礼しました。
ただ、（β） 2015/01/31(土) 16:49 のレスも含めて、コメントしたことは参考にしていただければ幸いです。
（β） 2015/01/31(土) 17:00
マナ様、ichinose様
教えてくださったコードに書き換えることで無事ハイパーリンクがつながるようになりました。
変数名もご指摘頂いたように変更しました。
ありがとうございます。
β様
このコードはネットで拾ったものを切り貼りしたので、そのような可能性についてよく分かっていませんでした。
ですのでβ様のお話はとても勉強になりました。
コメントありがとうございました。
（mogu） 2015/01/31(土) 17:20
Sheets("シート1").Hyperlinks.Add anchor:=v, Address:="", SubAddress:=Rng.Address(external:=True)
Dim Mylink As Variant
Mylink = v.Item(1).Hyperlink.Address
If Mylink <> "" Then
v.Fill.ForeColor.RGB = RGB(150, 0, 150)
End If
（mogu） 2015/01/31(土) 22:23
>v.Item(1).Hyperlink.Address
前回の投稿でも記述しましたが、オブジェクトを操作するには、 その手続きに沿って記述しなければなりません。
どんな手続きがあるのか？ は、マニュアルやHelp等を参照して確認しなければなりません。
v.Item(1) vは、Shapeオブジェクトですよね？ Shapeオブジェクトの手続き（プロパティやメソッド）にItem という名称があるか否かを確認してみてください。 VBAでは、難しい処理やOSの細かい事まで知らないと実現できないことが オブジェクトの手続きを介すことで 簡単な指定で実現できることがたくさんあります。便利になっています。
が、そのオブジェクトの手続きに何があるのかは、知らなければならないし、 その手続きのルールにのっとって記述することが必要です（当たり前ですが）。
オブジェクトにどんな手続きがあるのか？ は、HelpやWebで調べることができます。
Shapeオブジェクトの手続きに何があるのか？ HyperLinkオブジェクトには、どんな手続きがあるのか？ は、調べてみてください。
普段から、Help等を何気にながめていれば、必要なときに あれが使えるかも と頭に浮かんでくるものです。
今回の場合、
Shapeオブジェクトには、 HyperLink というHyperLinkオブジェクトを取得するプロパティがあります。 これを使えば、
>ハイパーリンクが設定されているかどうかの判定
は出来ると思います。
ハイパーリンクが設定されている図形と 設定されていない図形に対して、このHyperLinkプロパティ を取得して 違いを調べてみてください。
（ichinose） 2015/02/01(日) 10:03
vの後にItemがあるおかしさは、ichinose様のご説明でようやく理解できたかと思います。
オブジェクトの直後にそれぞれのオブジェクトに対応するメソッドやプロパティが続いていないのですね。
ありがとうございます。
ひとまず、教えていただいたshapeオブジェクトのHyperlinkプロパティについて、
マイクロソフトのヘルプを読み返してきました。
Shapeには.Hyperlinkプロパティがある
→Hyperlinkプロパティは図形のハイパーリンクを表す Hyperlink オブジェクトを取得する
→Hyperlink オブジェクトにはメソッド(Delete,Followなど)、プロパティ(Address、Parentなど)が存在する
今回Shapeはvに置き換えている
エクセルでハイパーリンクの内容を取得する方法
http://oshiete.goo.ne.jp/qa/2294383.html
これらから、
Mylink = v.Hyperlink.Address
で取得して、ハイパーリンクが設定されている図形と
設定されていない図形を比べようと思いました。
しかしエラーが出て失敗しました。
Shapeの方からではなくHyperlinksの方からたどる
下記のコードは一応うまく動きました。
Sub a()
For Each h In Worksheets("シート1").Hyperlinks
If h.Name <> "" Then h.Shape.Fill.ForeColor.RGB = RGB(0, 0, 0)
Next
End Sub
やりたかったこと自体は達成できたのですが、
前半に書いた部分は未だによくわかりません。
検索が下手なもので、もしよろしければ参考になるものを教えていただけたら幸いです。
（mogu） 2015/02/01(日) 12:41
HyperLinkプロパティについては
ichinoseさんに教わるとして、
βさんのコメントについて考えてみました。 こんな感じでもいいですかね。 まだエラーが出る可能性あるでしょうか。
Sub ShapeLink()
Dim v As Shape
Dim rng As Range
Dim myStr As String
For Each v In Sheets("シート1").Shapes
If v.Type = 1 Then 'msoAutoShape
If v.AutoShapeType > 0 Then '★これで十分かどうか？
'strにシート1図形内のテキストを代入
myStr = v.TextFrame.Characters.Text
Else
myStr = ""
End If
'strが空でなければ
If myStr <> "" Then
'シート2シートのstrの値を持つセルを検索する
Set rng = Worksheets("シート2").Cells.Find(What:=myStr, LookIn:=xlValues, LookAt:=xlWhole)
'シート1の図形にシート2のセルへのハイパーリンクを貼る(ここがおかしい？)
If Not v Is Nothing Then
v.Parent.Hyperlinks.Add anchor:=v, Address:="", SubAddress:=rng.Address(external:=True)
v.Fill.ForeColor.RGB = RGB(150, 0, 150)
End If
End If
End If
Next v
End Sub
（マナ） 2015/02/01(日) 13:54
> If myStr <> "" Then
> 'シート2シートのstrの値を持つセルを検索する
> Set rng = Worksheets("シート2").Cells.Find(What:=myStr, LookIn:=xlValues, LookAt:=xlWhole)
> 'シート1の図形にシート2のセルへのハイパーリンクを貼る(ここがおかしい？)
> If Not Rng Is Nothing Then ’ここは、勘違いでしょうね
> v.Parent.Hyperlinks.Add anchor:=v, Address:="", SubAddress:=rng.Address(external:=True)
> v.Fill.ForeColor.RGB = RGB(150, 0, 150)
> End If
> End If
マナさんが投稿された上記のコード、 私は最終的に moguさんに自らこの完成形のコードを投稿してほしかったのですが、 順序はちょっと逆になってしまいましたが、これはこれでよいでしょうね。
貴重なコードなので 参考にされてみては いかがでしょうか？
原型コードが On Error Resume Next を使ったコードなのと、拝見したコードが オブジェクトの使い方に何か誤解がありそうなコードだったので
ShapeオブジェクトのHyperLinkプロパティからのアプローチから始めようと思っていました。
On Error Resume Next を使う方法。私は、あながちダメな方法だとは思っていません。 これを使わなければできないことは たくさんあります。 使わなくても出来る場合でも、使って処理が可能ならば、それはそれで良いとさえ思っています。
但し、多用すると問題が発生する可能性もあるのです。
１ バグの発見が遅れる
On Error 〜 を使うことで本来エラーは発生する箇所でエラーが発生せずにコードが走ります。
このステートメントによって、本来は、コードの間違いである箇所もエラーが発生せずに
プログラムは動作し続けます。これが原因で無限ループになったり、いえ、無限ループになれば、
ここに問題があると気が付きますが、エラー発生しないのでバグの発見が大きく遅れる場合があります。
２ コードがわかりづらくなる
前回投稿の
v.Parent.Hyperlinks.Add Anchor:=v, Address:="", SubAddress:=rng.Address(, , , True)
このコード その前にFindメソッドを使って検出されたRangeオブジェクトがRngに格納されるという設定ですが、 もし、対象文字が見つからなければ、本来は、上記のコードでエラーになります。 実際には ここでも On Error 〜 が効いているのでエラーにはなりません。
On Error 〜 がこのエラー処理をカバーしているということに気づいていましたか？
このコードを読む人にとっても、この事実が非常にわかりづらいコードになっています。
On Error 〜 を使う場合、このような事には、十分な配慮が必要です。
私が考える対策としては、
On Error 〜 有効範囲をなるべく狭くすること。 On Error 〜 を使って、拾うエラー、又は、無視するエラーが分かりづらい場合は、 コメントで十分な説明を行うこと。
この２点を挙げておきます。
HyperLinkは、過程の中で出すつもりだったので、もう要らないのですが、
dim hyp as hyperlink
on error resume next
・
・
err.clear
set hyp=v.hyperlink
if err.number=0 then
’ハイパーリンク設定されている処理
else
'ハイパーリンクが設定されていない処理
end if
こんなコードでハイパーリンク設定の有無が確認できます。
このShapeオブジェクトのHyperlinkプロパティは、図形にハイパーリンクが設定されていれば、 正常にHyperlinkオブジェクトが取得できますが、図形にハイパーリンクが設定されていないと、 v.Hyperlinkとプロパティを呼び出した時点でエラーになってしまいます。
エラーになるならそのエラーを On Error 〜 を使って検出することでハイパーリンクの有無は確認できます。
こんな方法もあるという事で今回は マナさんコードをよく解析して見てはいかがですか？
最後にマナさんへ
> If v.Type = 1 Then 'msoAutoShape > If v.AutoShapeType > 0 Then '★これで十分かどうか？ > 'strにシート1図形内のテキストを代入 > myStr = v.TextFrame.Characters.Text > Else > myStr = "" > End If
良く調べられましたね！！ ちょっと気になって点です。
1 V.Type=1 以外にも Textframe.Characters.Text が取得できるShapeがありますが、これを無視しても 良いのか？
2 Excel2007以前のバージョンでは、テキストのない図形に対して、TextFrame.Characters.Textを呼び出すと エラーになるものがいくつもあります。互換性の問題として この点をどうするのか？
3 1にも関連することですが、新機能でフリーフォームにもテキスト登録が可能です。
この場合は、TextFrame2でないとテキストは取得できませんねえ。この点をどうするか？
では、Textframe2には Hastextというプロパティがあるから、これを使うか？
でも、ExcelControl ボタンなどに使うと妙な結果になることも気になります。
そもそもこれ限定で使うと 旧バージョンには、対応できなくなります。
この辺りを考慮すると結構大変そうですね！！
私自身はここは、気になった点というだけに留めておきますが・・・。
（ichinose） 2015/02/01(日) 18:24
ご指摘いただいた中で、特に２が気になりました。 Excel2002で試してみたら、確かにそうなりました。 ならば最初から、shapeでなく、DrawingObjectsを使いたくなてしまう。
（マナ） 2015/02/01(日) 20:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.