アドインで表示した印章をマクロで扱いたい

質問

印鑑を押すマクロ”電子印鑑”をアドインに登録したのですが、その印鑑をマクロ内で使う方法が解りません、マクロの記録では、
ActiveSheet.Shapes("Group 3").Select
と記録されます。
これを任意のセルに貼り付けるにはどうすればよいのでしょうか？
よろしくお願いします。

回答No.11

DOUGLAS_ · ベストアンサー

＞SendKeys "+{F10}EM", True
＞は、altとF10を同時に押すのですか、F10になにか登録する必要はないのでしょうか？
＞ATOKのプロパティを見たのですが登録のやり方が解りません出した。
　「altとF10」ではなくて [Shift] + [F10] です。

　[回答番号：No.4] に書きましたが、
＞　この方法のポイントは、(２) の操作を
＞SendKeys "+{F10}"
＞で行なう、ということです。

　で、(２)というのは、
＞２）右クリック（または、[コンテキスト メニュー キー] を押下）。
ですよね。

http://support.microsoft.com/kb/126449/ja
をご覧いただくとお分かりになると存じますが、

＞キーボードのみを使用するコマンド
＞Shift + F10 :
＞選択した項目のコンテキスト メニューを開く (オブジェクトの右クリックと同じ)。

＞コンテキスト メニューを表示するには Shift + F10 を押す。

と書いてあります。

　エクセルを立ち上げていようがなかろうが、どちらでも結構ですので、hakujira さんのパソコンで、[Shift] + [F10] を押下なさってみてください。
　マウスの右クリック、または、キーボードの [コンテキスト メニュー キー]（アプリケーション キー？）を押下したのと同じ現象が起こると存じますが。。。

お礼

遅くなってしまいましたが、ようやく出来ました。
原因は“Excel電子印鑑”の保存先が違っていたようです。
インストールした時にアドイン専用のフォルダを見つける事が出来なかった為、マイドキュメント内のフォルダに保存してしまいました。（解説書に「任意のフォルダに保存して参照ボタンから設定しても良い」とあった為です）
先ほどやっと見つけてaddinsに保存した所うまく動きました。
今回はいろんな意味で勉強になりました、今後はマクロよりもエクセルの基礎を重点的勉強していきます。
回答してくださったみなさん、本当にありがとうございました。

回答No.10

DOUGLAS_

＞知識が乏しい為、回答してくださる方の意図がつかめずに
＞歯がゆい思いをさせている事は、大変申し訳なく思っています。
　ぃぇぃぇ、私はそんなことは全然感じておりませんので、お気になさらないでください。
　大体、この程度のことで「歯がゆい思い」をされるような方は、こういうところには出入りされないと存じます。

＞[回答番号：No.4] の 「Sub Macro1()」を実行しようとしたのですが。
＞'[Excel電子印鑑(E)] - [認印押印(M)] の挿入や
＞'[Excel電子印鑑(E)] - [データネーム印押印(D)] の挿入．．．
＞の動作がマクロに記録されない為、上手く動きませんでした。
　私の呈示した [回答番号：No.4] の 「Sub Macro1()」はマクロを記録するものではありません。

　くどいようですが、hakujira さんがダウンロードして
＞印鑑を押すマクロ”電子印鑑”をアドインに登録
されたのは、
http://www12.plala.or.jp/nombo/soft10.html​
の「Excel電子印鑑」に　【【【【間違いありませんか？】】】】

　もし、他のアドインなのでしたら、私のこれまでの回答は全く無意味ですので、お見捨てください。

　上記を踏まえた上で、hakujira さんがお使いなのが、上記の「Excel電子印鑑」でしたら、手作業で押印されるときには、[回答番号：No.4] に書きましたように、
１）範囲選択。
２）右クリック（または、[コンテキスト メニュー キー] を押下）。
３）[Excel電子印鑑(E)] を選択。
４）[認印押印(M)] または [データネーム印押印(D)] または [ビジネス印押印(K)] を選択。
されますよね。

　それを、普通にマクロで記録しても、何もコーディングされませんので、[回答番号：No.4] に書きましたように、
＞実際にキーボードから ”電子印鑑” を押印される動作をそのままマクロに
記述したのが、[回答番号：No.4] の 「Sub Macro1()」です。

＞そのままコピペして実行しても指定したセルが青くなるだけでした。
とのことですが、[ツール(T)] - [アドイン(I)] - [有効なアドイン(A)]　- [Excel電子印鑑] に、
【【【【チェックが入って】】】】いますよね？

　確かに SendKeys ステートメント は微妙な動きをするかも分かりませんので、２～３回お試しになってみてください。

　以上のことをご理解いただいた上で、なおかつ、[回答番号：No.4] の 「Sub Macro1()」が動かないということでしたら、私はここで降りさせていただきます。
　というより、Excel や OS のバージョンも踏まえずに回答してしまった私のミスですので、お気になさらないでくださいませ。

　なお、
＞印章は４～１０カ所押すようになります。
とのことですが、押印されるのが「一文字のタイプ」ということでしたら、下記のように、お好きな範囲を指定しながら
SendKeys "+{F10}EM", True
を繰り返すだけのことです。

Sub Macro2()
　Range("A1:B2").Select
　SendKeys "+{F10}EM", True

　Range("C3:D5").Select
　SendKeys "+{F10}EM", True

　Range("E5:F6").Select
　SendKeys "+{F10}EM", True

　Range("G7:H7").Select
　SendKeys "+{F10}EM", True
End Sub

補足

SendKeys "+{F10}EM", True
は、altとF10を同時に押すのですか、F10になにか登録する必要はないのでしょうか？
ATOKのプロパティを見たのですが登録のやり方が解りません出した。
２～３日、時間を下さい明日から少し忙しくなる為帰宅が遅れますので、よろしくお願いします。

回答No.9

xls88

コメントをそのまま使われても駄目です。
コードに置き換えなければなりません。

　　Dim seru As Range
　　Dim gy
　　Dim re

　　gy = 6
　　re = 1

　　Cells(gy, re).Select '★1
　　Set seru = Range(ActiveCell.Address) '★2
　　'Set seru = Cells(gy, re) '☆a

　　ActiveSheet.Shapes("Group 7").Duplicate.Select '★3
　　With Selection.ShapeRange '★4
　　'With ActiveSheet.Shapes("Group 7").Duplicate　'☆b
　　　　.Left = seru.Left + (seru.Width - .Width) / 2
　　　　.Top = seru.Top + (seru.Height - .Height) / 2
　　End With

★1と★2は、☆a
★3と★4は、☆b
にすることができます。

お礼

ありがとうございます、うまくいきました。

補足

いつも丁寧な回答ありがとうございます、xls88さんの回答でも充分対応出来るのですが 、 DOUGLASさんのやり方ですと１行で済むので今回はDOUGLASさんの方法を採用することにしました。
これからも無きかありましたらよろしくお願いします。

回答No.8

xls88

＞回答番号：No.6 この回答への補足
コードを拝見できますか？
編集されたコードを全文提示してください。

補足

このようにしてみました
GY = 6
RE = 1
Cells(GY, RE).Select
Dim seru As Range
Set seru = Range(ActiveCell.Address)
ActiveSheet.Shapes("Group 7").Duplicate.Select
With Selection.ShapeRange
.seruのLeft +（seruのWidth - Shapes("Group 3")のWidth) / 2

.seruのTop +（seruのHeight - Shapes("Group 3")のHeight) / 2

End With

回答No.7

DOUGLAS_

＞そうですね、DOUGLAS_さんの作品だったのですね。
　ん？　何か勘違いなさっているようですが、[回答番号：No.5] に
＞私のマクロをお試しになってくださいましたでしょうか？
＞私のコードで実現できるはずなのですが。。。
と書きましたのは、[回答番号：No.4] の 「Sub Macro1()」のことです。

＞他に丸文字を作るソフトもあったのですが、電子印鑑の方が
＞気に入ったものですから、使わせて頂いています。
ということは、
http://www12.plala.or.jp/nombo/soft10.html
の「Excel電子印鑑」をお使いになっているということですよね。

＞それで、確かに最初に貼り付ける時は中央にきますが、補足欄に
＞記述したコードでコピーすると、左上に表示されてしまいます。
＞コピー先では無理なのでしょうか？
　でしたら、「補足欄に記述したコード」ではなくて、是非とも、[回答番号：No.4] の 「Sub Macro1()」をお試しになってみてください。

補足

[回答番号：No.4] の 「Sub Macro1()」を実行しようとしたのですが。
'[Excel電子印鑑(E)] - [認印押印(M)] の挿入や'[Excel電子印鑑(E)] - [データネーム印押印(D)] の挿入．．．の動作がマクロに記録されない為、上手く動きませんでした。
そのままコピペして実行しても指定したセルが青くなるだけでした。
知識が乏しい為、回答してくださる方の意図がつかめずに歯がゆい思いをさせている事は、大変申し訳なく思っています。

回答No.6

xls88

セル中央に配置するのは足し算、引き算をするだけです。

Shapes("Group 3")のLeftを、
seruのLeft +（seruのWidth - Shapes("Group 3")のWidth) / 2

Shapes("Group 3")のTopを、
seruのTop +（seruのHeight - Shapes("Group 3")のHeight) / 2

としてください。

補足

書き換えて実行してみましたが、
Left = seruのLeft +（seruのWidth - Shapes("Group 3")のWidth） / 2
.seruのLeft +（seruのWidth - Shapes("Group 3")のWidth） / 2
どちらも赤字になりコンパイルエラー、構文エラーになります。
下の構文は“のWidth”のところが青くなります。
Excel2000だからでしょうか？
エクセルの基礎知識も乏しいのでxls88さんも歯がゆいと思いますが、何とかお願いします。

回答No.5

DOUGLAS_

[回答番号：No.4] の DOUGLAS_ です。

＞印鑑を押すマクロ”電子印鑑”をアドイン
とお書きなのが、「Excel電子印鑑」（http://www12.plala.or.jp/nombo/soft10.html）のことでしたら、私のマクロをお試しになってくださいましたでしょうか？

＞贅沢を言えばセルの中央に表示したい
のでしたら、「Excel電子印鑑」でしたら、私のコードで実現できるはずなのですが。。。

補足

そうですね、DOUGLAS_さんの作品だったのですね。
他に丸文字を作るソフトもあったのですが、電子印鑑の方が気に入ったものですから、使わせて頂いています。
それで、確かに最初に貼り付ける時は中央にきますが、補足欄に記述したコードでコピーすると、左上に表示されてしまいます。
コピー先では無理なのでしょうか？

回答No.4

DOUGLAS_

実際にキーボードから ”電子印鑑” を押印される動作をそのままマクロに実行させるのが簡単かと存じます。

１）範囲選択。
２）右クリック（または、[コンテキスト メニュー キー] を押下）。
３）[Excel電子印鑑(E)] を選択。
４）[認印押印(M)] または [データネーム印押印(D)] または [ビジネス印押印(K)] を選択。

※ [ビジネス印押印(K)] のときは、オプションを選ぶ動作が SendKeys ステートメント で動作しないかも知れませんので、予めお好みの設定をしておいて、{ENTER} だけ送るのがよいかも知れません。

　この方法のポイントは、(２) の操作を
SendKeys "+{F10}"
で行なう、ということです。

Sub Macro1()
　Range("A1:B2").Select
　'[Excel電子印鑑(E)] - [認印押印(M)] の挿入
　SendKeys "+{F10}EM", True

　Range("C1:D2").Select
　'[Excel電子印鑑(E)] - [データネーム印押印(D)] の挿入
　SendKeys "+{F10}ED", True

　Range("E1:F2").Select
　'[Excel電子印鑑(E)] - [ビジネス印押印(K)] の挿入
　SendKeys "+{F10}EK{ENTER}", True
End Sub

補足

質問の仕方がおかしかった為、みなさんにとんだご足労をかけてしまったようですが、みなさんの回答を元にネットで検索した所、何とかたどり着きました。
GY = 6
RE = 1
Cells(GY, RE).Select
　 Dim seru As Range
　Set seru = Range(ActiveCell.Address)
　ActiveSheet.Shapes("Group 3").Duplicate.Select
　With Selection.ShapeRange
　.　Left = seru.Left
　.　Top = seru.Top
　 End With
個々の意味はよく理解できてはいませんが、とりあえずこれで任意のセルにコピーできるようになりました。
ただ、贅沢を言えばセルの中央に表示したいのですが、２つのサイトのどちらも左上にあわせる書式しか載っていませんでした、中央に寄せる方法はないのでしょうか？
ちなみにコピー先のセルの大きさは皆同じです。

回答No.3

xls88

グループ化された図形内の図形は
GroupItems(インデックス)
で操作できます。
Msgbox ActiveSheet.Shapes("Group 3").GroupItems.Count

＞この一文字タイプの情報を入手して複数カ所に押印する方法をお願いします。
コピーして貼り付けるだけなら、情報を取得する必要はないと思います。

＞印章は４～１０カ所押すようになります。
cadd = Array("G2", "H5", "I8")
ActiveSheet.Shapes("Group 3").Copy
With ActiveSheet
For i = LBound(cadd) To UBound(cadd)
.Paste
With .Shapes(.Shapes.Count)
.Left = Range(cadd(i)).Left
.Top = Range(cadd(i)).Top
End With
Next i
End With

お礼

いつも回答ありがとうございます、ＮＯ４の方の補足欄に、補足させてもらいました

回答No.2

n_na_tto

アドインで貼り付けた【印鑑】を自作のマクロで移動したりするということだと思って回答しました。しかしその後の補足を読むと、【アドインのコード】を自作のマクロ内で呼び出したい、ということのようですね。

○○○○.xlaの△△という名前のプロシージャを呼び出すなら

Application.Run "○○○○.xla!△△"

でしょうが、今回△△は不明ですしね....さてどうしたものか。
ま、がんばってください。

お礼

回答ありがとうございます、ＮＯ４の方に補足させてもらいました

回答No.1

n_na_tto

【最後】に挿入した図形をB10に移動、サイズ調整するなら..

Sub test()
Dim myRng As Range
Set myRng = Range("B10")
With ActiveSheet.Shapes
　With .Item(.Count) '最後に挿入した図形
　　.LockAspectRatio = True
　　.Left = myRng.Left
　　.Top = myRng.Top
　　.Width = myRng.Width
　　If .Height > myRng.Height Then
　　　.Height = myRng.Height
　　End If
　End With
End With
End Sub

シート上の複数の【グループ図形】をB列の上から順にはめ込んでいくなら

Sub test2()
Dim Shp As Shape
Dim myRng As Range
Dim n As Long
n = 1
For Each Shp In ActiveSheet.Shapes
　With Shp
　　If .Type = msoGroup Then
　　　Set myRng = Cells(n, 2)
　　　.LockAspectRatio = True
　　　.Left = myRng.Left
　　　.Top = myRng.Top
　　　.Width = myRng.Width
　　　If .Height > myRng.Height Then
　　　　.Height = myRng.Height
　　　End If
　　　n = n + 1
　　End If
　End With
Next
End Sub

補足

申し訳ありません出した、質問に不備がありました。
印章は４～１０カ所押すようになります。
２文字のタイプは
ActiveSheet.Shapes("AutoShape 7").Select
Selection.Characters.Text = "回覧"
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "標準"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
と記録されるのですが、一文字のタイプは
ActiveSheet.Shapes("Group 3").Selectとしか記録されません。
Shapesの意味も使い方も解らない為ネットで調べたのですが見つかりませんでした。
この一文字タイプの情報を入手して複数カ所に押印する方法をお願いします。