[[20150115124647]]　『【再度のお願い】カレンダーから日付入り表を作成』（mie）　ページの最後に飛ぶ

『【再度のお願い】カレンダーから日付入り表を作成したい』（mie）

よろしくお願いします。

 「カレンダー」シートに1日1セル（書式"d"）で年間カレンダーがあります
 ある日付をクリックし、マクロを発動させたら
 「今月」シートの「日付」と入力してあるセル（場所は不定）
 にカレンダーシートの選択した日付をコピーしたいのですが、
 どのようにしたらできるでしょうか。
 ご指導ください。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 Sub Macro1()

     Dim r As Long, c As Long

     r = Sheets("今月").Cells.Find(what:="日付", lookat:=xlWhole).Row
     c = Sheets("今月").Cells.Find(what:="日付", lookat:=xlWhole).Column

     Sheets("今月").Cells(r, c) = Format(ActiveCell, "yyyy/m/d")

 End Sub

 みたいなことでしょうか？違っていたらすいません。
（se_9） 2015/01/15(木) 13:13

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

 完璧に動きました。
 お世話になりました。
（mie） 2015/01/15(木) 13:33

大変申し訳ありません。

 追加で教えていただけないでしょうか。
 se_9さんのマクロで日付をコピペできましたが
 カレンダーのポイントした部分と日付をコピペした部分を
 ハイパーリンクでつなぎたいのですが、可能でしょうか？
 カレンダー部分の日付をクリックしたら
 飛ぶようにしたいのですが。
 よろしくお願いします。
（mie） 2015/01/15(木) 17:42

 セルにハイパーリンクを設定する作業をマクロの自動記録してみてください。
 後は、自動記録のコードを修正してFindメソッドで取得したセルのアドレスを埋め込むようにします。
（カリーニン） 2015/01/15(木) 21:12

カリーニンさん

 ご指導ありがとうございます。
 職場PCなので、日中トライしてみます。
 できるかどうか不安ですが
 結果報告しますので
 またご指導ください。

（mie） 2015/01/16(金) 06:49

カリーニンさん

 下記のマクロで無事動きました。
  Sub テスト()
     Dim r As Long, c As Long

     r = Sheets("今月").Cells.Find(what:="日付", lookat:=xlWhole).Row
     c = Sheets("今月").Cells.Find(what:="日付", lookat:=xlWhole).Column

     Sheets("カレンダー").Select
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "今月!r:c"

     Selection.Font.Bold = True
     Sheets("今月").Cells(r, c) = Format(ActiveCell, "yyyy/m/d")

  End Sub
 動くのはこれで動いておりますが
 内容的に問題ないでしょうか？
 よろしくお願いします。
（mie） 2015/01/16(金) 10:03

 ぱっと見で実機で試してませんが、

 >"今月!r:c"

 はまずいようにおもいます。

 サンプルです。

Sub test()

  Dim r As Long, c As Long
  Dim rng As Range
  Dim wsA As Worksheet
  Dim wsB As Worksheet
  Dim accel As Range

     Set wsB = Worksheets("カレンダー")
     Set accel = ActiveCell

     Set wsA = Worksheets("今月")
     Set rng = wsA.Cells.Find(what:="日付", lookat:=xlWhole)

     wsB.Hyperlinks.Add Anchor:=accel, Address:="", SubAddress:= _
        "今月!" & rng.Address(0, 0)

     accel.Font.Bold = True
     rng.Value = Format(accel.Value, "yyyy/m/d")

     Set accel = Nothing
     Set rng = Nothing
     Set wsA = Nothing
     Set wsB = Nothing
  End Sub
（カリーニン） 2015/01/16(金) 12:19

 あるいは、↓のような感じでも。

Sub test2()

  Dim r As Long, c As Long
  Dim rng As Range
  Dim wsA As Worksheet
  Dim wsB As Worksheet
  Dim accel As Range

     Set wsB = Worksheets("カレンダー")
     Set accel = ActiveCell

     Set wsA = Worksheets("今月")
     Set rng = wsA.Cells.Find(what:="日付", lookat:=xlWhole)
     r = rng.Row
     c = rng.Column

     wsB.Hyperlinks.Add Anchor:=accel, Address:="", SubAddress:= _
        "今月!" & wsB.Cells(r, c).Address(0, 0)

     accel.Font.Bold = True
     rng.Value = Format(accel.Value, "yyyy/m/d")

     Set accel = Nothing
     Set rng = Nothing
     Set wsA = Nothing
     Set wsB = Nothing
  End Sub
（カリーニン） 2015/01/16(金) 12:23

カリーニンさん

 返信ありがとうございます。
 私がどこか間違えているようで
 教えていただいた、内容ではいずれも
 エラーが出てしまいます。
 もう一度、一からやりなおしてみますので
 少々お時間を下さい。
（mie） 2015/01/17(土) 04:17

 >エラーが出てしまいます。

 どのようなエラーでしょう？
 どのようなエラーメッセージが出ますか？
 エクセルが発するエラーですか？
 VBAが発するエラーですか？
 VBAが発するエラーでしたらコードのどこで出てますか？
（カリーニン） 2015/01/17(土) 08:51

コメント返信：

[ 一覧(最新更新順) ]

[[20150115124647]] 『【再度のお願い】カレンダーから日付入り表を作成』（mie） ページの最後に飛ぶ

[[20150115124647]]　『【再度のお願い】カレンダーから日付入り表を作成』（mie）　ページの最後に飛ぶ