Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1904 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【71109】オートシェイプに自動的に値を入力したい。 かかこ 12/1/30(月) 12:02 質問[未読]
【71112】Re:オートシェイプに自動的に値を入力した... かかこ 12/1/30(月) 13:21 発言[未読]
【71113】Re:オートシェイプに自動的に値を入力した... かかこ 12/1/30(月) 13:24 発言[未読]
【71117】Re:オートシェイプに自動的に値を入力した... UO3 12/1/30(月) 14:09 発言[未読]
【71116】Re:オートシェイプに自動的に値を入力した... UO3 12/1/30(月) 13:54 発言[未読]
【71118】Re:オートシェイプに自動的に値を入力した... かかこ 12/1/30(月) 14:28 発言[未読]
【71119】Re:オートシェイプに自動的に値を入力した... UO3 12/1/30(月) 14:41 回答[未読]
【71120】Re:オートシェイプに自動的に値を入力した... かかこ 12/1/30(月) 14:55 お礼[未読]
【71109】オートシェイプに自動的に値を入力したい...
質問  かかこ  - 12/1/30(月) 12:02 -
引用なし
パスワード
   こんにちは、詰まってしまいました。よろしくお願いします。

使用ワークシート：チェック、sheet1
やりたいこと：チェック上にあるオートシェイプRectangle 26に値（日付）が自動的に入力されるようにしたい。

下記コードを書きました。

Sub Macro1()
　　Sheets("チェック").Select

　　Dim FoundCell As Variant
　　Dim findvalue As Variant
　　Dim findline As Long
　　Dim findcolumn As Long
　　
　　findvalue = ActiveSheet.Range("AC7").Value
　　With Worksheets("sheet1")
　　　　Set FoundCell = .Columns("A:A").Find(findvalue)
　　　　If FoundCell Is Nothing Then
　　　　　　MsgBox "見つかりません。", vbExclamation
　　　　Else
　　　　　　findline = FoundCell.Row
　　　　　　findcolumn = FoundCell.Column
　　　　　　MsgBox findline & "行目です。", vbInformation
　　　　
　　　　End If
　　End With
　　
　　ActiveSheet.Shapes("Rectangle 26").Select
　　
　　'ExecuteExcel4Macro "=FORMULA("=sheet1!D""" & findline & """)"　 ←コンパイルエラー

　　'ExecuteExcel4Macro "FORMULA(""=sheet1!R[71]C[3]"")"　←　ﾏｸﾛ登録でエクセルが作ったﾏｸﾛ

End Sub

上記コードで、コンパイルエラーと書いたところでまずエラーが出ます。
これは、その下の"ﾏｸﾛ登録でエクセルが作ったﾏｸﾛ"の部分の文章を私が書き換えたのですが、まずこれからして間違っています。=sheet1!R[71]C[3]の部分を変数にしたい（列は固定です）

どうか、正しい方法を教えてください。よろしくお願いします。
【71112】Re:オートシェイプに自動的に値を入力し...
発言  かかこ  - 12/1/30(月) 13:21 -
引用なし
パスワード
   ▼かかこ さん：
間違い訂正と補足をします。

ExecuteExcel4Macroで引っ張りたいのはsheet1のK列の一番下の行に入っているものです。


>'ExecuteExcel4Macro "=FORMULA("=sheet1!D""" & findline & """)"　 ←コンパイルエラー

の部分下記のように直しました。

ExecuteExcel4Macro "FORMULA(""=sheet1!R[& findline &]C[11]"")"

しかし、動きません。（何も入らない）

エクセルが作ったﾏｸﾛ
ExecuteExcel4Macro "FORMULA(""=物品購入番号!R[71]C[10]"")"
とするとちゃんと動きます。（なぜ71と10なのか理解できてないですけど・・・）

よろしくお願いします。
【71113】Re:オートシェイプに自動的に値を入力し...
発言  かかこ  - 12/1/30(月) 13:24 -
引用なし
パスワード
   ▼かかこ さん：
>ExecuteExcel4Macro "FORMULA(""=sheet1!R[& findline &]C[11]"")"

また間違えた。
ExecuteExcel4Macro "FORMULA(""=sheet1!R[& findline &]C[10]"")"
です。
【71116】Re:オートシェイプに自動的に値を入力し...
発言  UO3  - 12/1/30(月) 13:54 -
引用なし
パスワード
   ▼かかこ さん：

>ExecuteExcel4Macroで引っ張りたいのはsheet1のK列の一番下の行に入っているものです。

アップされたコードは、こうなっていませんけど？
・どのシートか不明ですが、アクティブシートのAC7の値でSheet1のA列を検索。
・あれば、その行番号をfindlineに格納。（なければ何も格納しない）
・あってもなくても、無条件に、K列の、その行の値への参照式を四角形にセット。
　（なければ、不具合になると思うけど）
こんなコードですよね？
【71117】Re:オートシェイプに自動的に値を入力し...
発言  UO3  - 12/1/30(月) 14:09 -
引用なし
パスワード
   ▼かかこ さん：

上で質問したとおり、実際におやりになりたいのが、どういうことなのかは
把握しきっていないのですが、参考コードとして。

シェープに参照式を登録する操作をマクロ記録しますと、
確かにExcel4Macroが生成されますが、以下のコードでも参照の設定が可能です。

Sample1は同じシートのK30を登録。
Sample2は、ブック内のSheet1のK列の最終行のセルを登録しています。

Sub Sample1()
　　ActiveSheet.Shapes("Rectangle 26").DrawingObject.Formula = "K30"
End Sub

Sub Sample2()
　　Dim adr As String
　　With Sheets("Sheet1")
　　　　adr = .Range("K" & .Rows.Count).End(xlUp).Address(External:=True)
　　　　ActiveSheet.Shapes("Rectangle 26").DrawingObject.Formula = adr
　　End With
End Sub
【71118】Re:オートシェイプに自動的に値を入力し...
発言  かかこ  - 12/1/30(月) 14:28 -
引用なし
パスワード
   ▼UO3 さん：
>▼かかこ さん：
>
>>ExecuteExcel4Macroで引っ張りたいのはsheet1のK列の一番下の行に入っているものです。
>
>アップされたコードは、こうなっていませんけど？
>・どのシートか不明ですが、アクティブシートのAC7の値でSheet1のA列を検索。
>・あれば、その行番号をfindlineに格納。（なければ何も格納しない）
>・あってもなくても、無条件に、K列の、その行の値への参照式を四角形にセット。
>　（なければ、不具合になると思うけど）
>こんなコードですよね？

おはずかしい・・・その通りです。
どこから最終行が出てきたのやら（おそらくテストしてたデータが最終行だったためと思われます）

最終行というのは忘れてください。ご迷惑をおかけしました。
【71119】Re:オートシェイプに自動的に値を入力し...
回答  UO3  - 12/1/30(月) 14:41 -
引用なし
パスワード
   ▼かかこ さん：

元のコードをベースにしたほうがいいのかもしれませんが。

Sub Test()
　　Dim findvalue As Variant
　　Dim findline As Variant
　　
　　With Sheets("チェック")
　　　　findvalue = .Range("AC7").Value
　　　　findline = Application.Match(findvalue, Sheets("Sheet1").Columns("A"), 0)
　　　　If Not IsNumeric(findline) Then
　　　　　　MsgBox "見つかりません。", vbExclamation
　　　　Else
　　　　　　.Shapes("Rectangle 26").DrawingObject.Formula = "Sheet1!K" & findline
　　　　End If
　　End With
　　
End Sub
【71120】Re:オートシェイプに自動的に値を入力し...
お礼  かかこ  - 12/1/30(月) 14:55 -
引用なし
パスワード
   ▼UO3 さん：

うまくいきました！ありがとうございました！
とてもスッキリしたコードで勉強になりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1904 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free