[[20110116154359]]　『リンクについて（VBA）』（ターちゃん）　ページの最後に飛ぶ

『リンクについて（VBA）』（ターちゃん）

シートを移動できるように図形にハイパーリンクを設定しています。

クリックしたときにそのシート内の指定したセルに入力がないときにエラーメッセージを表示させたいのですがVBAで可能でしょうか？

よろしくお願いします。

 ハイパーリンクではなくマクロで制御する案です。
 標準モジュールに

  Sub test()
  Const myAddress As String = "Sheet2!A1"
  If Range(myAddress).Value <> "" Then
    Application.Goto Range(myAddress)
  Else
    MsgBox "移動先の値がありません"
  End If
  End Sub

 のように書いておいて、図形にマクロの登録でtestを登録してみてください。
 例ですとSheet2のA1セルに値があれば移動しますし無ければメッセージを出します。
 （ｍｏｍｏ）

MOMOさんありがとうございます。

上記のモジュールで出来たのですが2つ以上のセルに同じメッセージを出す場合どうすれば良いのでしょうか？

又、ハイパーリンクを外していますので文字の表示はされますが飛ばしたいシートに飛びません。クリックしたときに空欄ならエラーメッセージが出て文字を書いていれば指定したシートに飛ぶようにしたいです。

よろしくお願いします

（ターちゃん）

 Const myAddress As String = "Sheet2!A1"
 ここの飛ぶ先のアドレスを目的の場所に書き換えてください。

 ２つ以上であればtest2などにふやしてアドレスを変えて登録してください。
 （ｍｏｍｏ）

"Sheet2!A1"とは図形をクリックしたときに空白かどうかを確認するセルではないのですか？

"Sheet2!A1"を変更してみましたが飛ばしたいシートには飛びませんでした。

何処に記入すればよいのでしょうか？

test2など増やしたのですが1つの図形に1つのマクロしか設定できませんでした。

初心者で大変申し訳ありませんがよろしくお願いします。

（ターちゃん）

 ん？　何か私が勘違いしてるようですね。

 こういう事でしょうか？

  Sub test()
  Const myAddress1 As String = "Sheet1!A1"  '確認するセル１
  Const myAddress2 As String = "Sheet1!A2"  '確認するセル２
  Const JunpAddress As String = "Sheet2!A1" '飛ぶ先のセル

  If Range(myAddress1).Value = "" Then
    MsgBox myAddress1 & "に値がありません"
  ElseIf Range(myAddress2).Value = "" Then
    MsgBox myAddress2 & "に値がありません"
  Else
    Application.Goto Range(JunpAddress)
  End If
  End Sub

ありがとうございました。

思っていたことができました。

感謝感謝です。またお世話になると思いますのでよろしくお願いいたします。

MOMOさんありがとうございました。

あと一つお聞きしたいのですが、A1及びA2のセルに記入がない場合その部分の色を変える方法はありますか？記入すれば元の色に戻るようにしたいのですが可能でしょうか？

よろしくお願いします。

（ターちゃん）

 それはマクロじゃなくても条件付き書式でも良いのでは？
 =A1=""　などを条件として。
 （ｍｏｍｏ）

説明不足ですいません。

図形をクリックしたときに記入がない場所の色が変わるようにしたいです。

よろしくお願いします。

（ターちゃん）

 ん～　戻すのに工夫が必要ですよ？
 戻す方はシートのオブジェクトモジュールのイベントを使います。

  Sub test()
  Const myAddress1 As String = "Sheet1!A1"  '確認するセル１
  Const myAddress2 As String = "Sheet1!A2"  '確認するセル２
  Const JunpAddress As String = "Sheet2!A1" '飛ぶ先のセル

  If Range(myAddress1).Value = "" Then
    MsgBox myAddress1 & "に値がありません"
    Range(myAddress1).Interior.ColorIndex = 6
  ElseIf Range(myAddress2).Value = "" Then
    MsgBox myAddress2 & "に値がありません"
    Range(myAddress2).Interior.ColorIndex = 6
  Else
    Application.Goto Range(JunpAddress)
  End If
  End Sub

  'オブジェクトモジュール
  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Application.Intersect(Target, Me.Range("A1,A2")) Is Nothing Then Exit Sub
  If Target.Value <> "" Then Target.Interior.ColorIndex = xlNone
  End Sub

 （ｍｏｍｏ）

実行時エラー1004

'Goto'メソッドは失敗しました:'pplication'オブジェクト

といったエラーメッセージが出てきます。

何でしょうか？

（ターちゃん）

 Const JunpAddress As String = "Sheet2!A1"

 ここの行はどうなっていますか？
 実際のアドレスになっていますか？
 （ｍｏｍｏ）

とんだ先のシートを保護していたのでこのようなエラーが出てきたのだと思います。

保護の解除をするとエラーは出てきませんでした。

保護をしてエラーが出ないようにするにはどうすれば良いのでしょうか？

（ターちゃん）

 シートを変えるだけでよければ
 >Const JunpAddress As String = "Sheet2!A1"
 を
 Const JunpAddress As String = "Sheet2"

 >Application.Goto Range(JunpAddress)
 を
 Worksheets(JunpAddress).Activate
 に変更してみてください
 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110116154359]] 『リンクについて（VBA）』（ターちゃん） ページの最後に飛ぶ

[[20110116154359]]　『リンクについて（VBA）』（ターちゃん）　ページの最後に飛ぶ