Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows XP Professional : Excel 2013)
マクロ使用にて、図形にハイパーリンクをつける方法
投稿日時: 18/01/10 13:45:26
投稿者: テル民

ボタンを押す事で、図形を作成するマクロを組んでいます。作成された図形に表示される文字は、別のセルに入力した内容をかえす様にしてあります。
ここからですが、別のセルに入力してあるアドレスを返して、作成された図にハイパーリンクをつけることは出来ないでしょうか?
他の方法であっても構いません。※現在までのコードを下記に記載いたします。
何分初心者なもので、知識が不足しております。
お手数ですが、宜しくお願い致します。
 
Sub 図形追加_Click()
 
  With ActiveSheet.Shapes.AddShape(msoShapeBevel, 0, 0, 161, 50)
        
     With .TextFrame.Characters
      .Text = Range("B3")
      .Font.Size = 11
      .Font.FontStyle = "Bold"
     End With
      
   .Name = Range("B3")
   .TextFrame.HorizontalAlignment = xlHAlignCenter
   .TextFrame.VerticalAlignment = xlVAlignCenter
   .Top = Range("M3").Top
   .Left = Range("M3").Left
       
  End With
        
End Sub

回答
投稿日時: 18/01/10 14:29:12
投稿者: sk

引用:
別のセルに入力してあるアドレスを返して、作成された図に
ハイパーリンクをつけることは出来ないでしょうか?

引用:
With ActiveSheet.Shapes.AddShape(msoShapeBevel, 0, 0, 161, 50)

Dim xlsRange As Excel.Range
Dim xlsShape As Excel.Shape
 
With ActiveSheet
   
  Set xlsShape = .Shapes.AddShape(msoShapeBevel, 0, 0, 161, 50)
  Set xlsRange = .Range("C3")
   
  If xlsRange.Text <> "" Then
    .Hyperlinks.Add Anchor:=xlsShape, _
                    Address:=xlsRange.Text
  End If
 
  Set xlsRange = Nothing
  Set xlsShape = Nothing
 
End With
------------------------------------------------------------------------
 
Hyperlinks オブジェクトの Add メソッドを使用し、その際にアンカーとして
任意の図形( Excel.Shape オブジェクト)を指定するようになさればよろしいかと。

回答
投稿日時: 18/01/10 14:42:50
投稿者: もこな2

あんまり自信ないですけど、こうですかね・・・(テストもしてないです。ご注意ください。)
と、メモ帳で編集してたらskさんがフォローされてましたので、解決してるとおもいますけど、既存のコードに追加するならこうでしょうか
 

Sub 図形追加_Click()

Dim シェイプ As Object

With ActiveSheet.Shapes.AddShape(msoShapeBevel, 0, 0, 161, 50)

     With .TextFrame.Characters
      .Text = Range("B3")
      .Font.Size = 11
      .Font.FontStyle = "Bold"
     End With

   .Name = Range("B3")
   .TextFrame.HorizontalAlignment = xlHAlignCenter
   .TextFrame.VerticalAlignment = xlVAlignCenter
   .Top = Range("M3").Top
   .Left = Range("M3").Left

    'ハイパーリンク関係
    Set シェイプ = Shapes(.Name)
    With シェイプ.Parent.Hyperlinks
        .Add Anchor:=シェイプ, Address:=「リンク先アドレスが書いてあるセル.Value」
    End With

投稿日時: 18/01/10 15:45:35
投稿者: テル民

>sk様
ありがとうございます。
教えていただいたコードの場合、フォントサイズや作成した図形に表記する文字をセルから拾うコードは
どこにいれればいいのでしょうか?
  
何度も申し訳ありません。
  
>もこな2様
ありがとうございます。コピペさせていただいてリンク先セルの部分を記入して動かしましたが、
どうにもエラーになってしまいます。
自分の間違いをもう一度確認します。
 

回答
投稿日時: 18/01/10 16:04:53
投稿者: sk

引用:
教えていただいたコードの場合、フォントサイズや作成した図形に
表記する文字をセルから拾うコードはどこにいれればいいのでしょうか?

Sub 図形追加_Click()
  
  Dim xlsRange As Excel.Range
  Dim xlsShape As Excel.Shape
   
  With ActiveSheet
     
    Set xlsShape = .Shapes.AddShape(msoShapeBevel, 0, 0, 161, 50)
     
    With xlsShape
           
      With .TextFrame.Characters
        .Text = Range("B3")
        .Font.Size = 11
        .Font.FontStyle = "Bold"
      End With
         
      .Name = Range("B3")
      .TextFrame.HorizontalAlignment = xlHAlignCenter
      .TextFrame.VerticalAlignment = xlVAlignCenter
      .Top = Range("M3").Top
      .Left = Range("M3").Left
     
    End With
     
    Set xlsRange = .Range("C3")
     
    If xlsRange.Text <> "" Then
      .Hyperlinks.Add Anchor:=xlsShape, _
                      Address:=xlsRange.Text
    End If
   
    Set xlsRange = Nothing
    Set xlsShape = Nothing
   
  End With
         
End Sub
---------------------------------------------------------------
 
とりあえず、それぞれの変数が何を参照しているか、
それが何の型であるかを読み解かれることをお奨めします。

投稿日時: 18/01/10 16:05:16
投稿者: テル民

>sk様
 
出来ました。ありがとうございます。
ご指摘の通り、まだまだ理解できておりませんので、教えていただいたものをもとに勉強させていただきます。
 
本当にありがとうございました。