専門家に聞いた!繰り返す痔の原因は!? >>

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

このQ&Aに関連する最新のQ&A

A 回答 (11件中1~10件)

>SendKeys "+{F10}EM", True


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

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

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


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

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

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

と書いてあります。

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

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

お礼日時:2009/03/16 22:32

>知識が乏しい為、回答してくださる方の意図がつかめずに


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


>[回答番号: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] に書きましたように、
1)範囲選択。
2)右クリック(または、[コンテキスト メニュー キー] を押下)。
3)[Excel電子印鑑(E)] を選択。
4)[認印押印(M)] または [データネーム印押印(D)] または [ビジネス印押印(K)] を選択。
されますよね。

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

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


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

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

 なお、
>印章は4~10カ所押すようになります。
とのことですが、押印されるのが「一文字のタイプ」ということでしたら、下記のように、お好きな範囲を指定しながら
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のプロパティを見たのですが登録のやり方が解りません出した。
2~3日、時間を下さい明日から少し忙しくなる為帰宅が遅れますので、よろしくお願いします。

補足日時:2009/03/15 22:54
    • good
    • 0

コメントをそのまま使われても駄目です。


コードに置き換えなければなりません。

  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さんのやり方ですと1行で済むので今回はDOUGLASさんの方法を採用することにしました。
これからも無きかありましたらよろしくお願いします。

補足日時:2009/03/17 20:33
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/03/15 22:10

>回答番号: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

補足日時:2009/03/15 21:29
    • good
    • 0

>そうですね、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)] の挿入...の動作がマクロに記録されない為、上手く動きませんでした。
そのままコピペして実行しても指定したセルが青くなるだけでした。
知識が乏しい為、回答してくださる方の意図がつかめずに歯がゆい思いをさせている事は、大変申し訳なく思っています。

補足日時:2009/03/15 21:26
    • good
    • 0

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



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さんも歯がゆいと思いますが、何とかお願いします。

補足日時:2009/03/15 21:01
    • good
    • 0

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



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

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

この回答への補足

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

補足日時:2009/03/15 20:20
    • good
    • 0

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



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

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

 この方法のポイントは、(2) の操作を
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
個々の意味はよく理解できてはいませんが、とりあえずこれで任意のセルにコピーできるようになりました。
ただ、贅沢を言えばセルの中央に表示したいのですが、2つのサイトのどちらも左上にあわせる書式しか載っていませんでした、中央に寄せる方法はないのでしょうか?
ちなみにコピー先のセルの大きさは皆同じです。

補足日時:2009/03/15 19:21
    • good
    • 0

グループ化された図形内の図形は


GroupItems(インデックス)
で操作できます。
Msgbox ActiveSheet.Shapes("Group 3").GroupItems.Count

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

>印章は4~10カ所押すようになります。
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
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/03/15 19:28

アドインで貼り付けた【印鑑】を自作のマクロで移動したりするということだと思って回答しました。

しかしその後の補足を読むと、【アドインのコード】を自作のマクロ内で呼び出したい、ということのようですね。

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

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

でしょうが、今回△△は不明ですしね....さてどうしたものか。
ま、がんばってください。
    • good
    • 1
この回答へのお礼

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

お礼日時:2009/03/15 19:25

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCELで作成した見積書に印鑑を押す方法。

はじめまして。
このたび、取引先のために見積書を作成しております。
以前、別の取引会社から提出いただいたPDF形式の見積書に印鑑が押されていました。

PC上で見ても印鑑が押されているのですが、これはどのようにすればできるのでしょうか?

おそらくエクセルで作成されたものがPDFに変換されているため、エクセル作成時点でこちらで質問させていただきました。

どうかよろしくお願いいたします。

Aベストアンサー

私の場合は、エクセル、ワードなどのソフトで見積書を作成し、
印鑑をスキャナーで画像(jpg)処理して、赤い部分(朱肉)のところ以外は透明にして、押印したい場所に貼り付ければ、あたかも押印したように見えます。
印鑑は、画像貼り付けということです。
なお、文字などに印鑑が重ならないのであれば、透明にする作業は省いてOKです。

Q印鑑(日付印)の作成について

日付・名前などが記載された印鑑(日付印)をビットマップファイルなどで作成し、そのファイルをエクセルに貼り付けたいと考えています。
ビットマップファイルなどをエクセルに貼り付ける方法は分かるのですが、印鑑を作成する方法が分かりません。
日付無しの印鑑の場合はあらかじめフリーソフトなどで作成した印鑑イメージを事前に準備できれば問題なのですが、日付付きで行いたいので日々 印鑑イメージが変わっていきます。

VBからの指令でイメージファイルを作成できるライブラリ等をご存じの方 いらっしゃいませんでしょうか?
また「あるソフト」にコマンドを投げかけるやり方でも構いません。

以上、宜しくお願いいたします m(__)m

開発言語:VB6(SP6)
OS:WindowsXp(SP2)

Aベストアンサー

あらかじめ 日付部分のみ空欄の印鑑イメージをBMPファイルなどで準備します

デザイン時にピクチャーボックスのPictureプロパティに作成したイメージを設定します
このピクチャーボックスのAutoRedrawプロパティを Trueにします
日付のデータなどを設定するコントロールを貼り付け
イメージを作成するボタンなどを配置します

ボタンのクリックイベントで
' 前回の描画をクリア
Picture1.Cls
Picture1.CurrentX = 希望の位置のX
Picture1.CurrentY = 希望の位置のY
Picture1.Print Text1.Text
SavePicture Picture1.Image, "希望のファイル名"
といった具合でBMPファイルを作成可能です

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

QExcel電子印鑑について

Excel2013にてフリーソフト電子印鑑「EXSTAMP」を使用していますが、昨日まで使えていたのですが
今日になって使えなくなってしまいました。特に設定など変更した覚えもなく、印鑑設定で名前を変更しようとすると、 「Drawing ObjectクラスのDeleteメソッドが失敗しました」とエラーメッセージが出ます。

あんまり詳しくないので、どなたか分かり易く教えてください。

Aベストアンサー

電子印鑑「EXSTAMP」は無料ソフトですので、再インストールしてみて下さい。

Qエクセル表中に入力条件に対応した図(jipファイル)を表示したいのですが。。。

エクセル97で保険契約の契約内容入力フォームを作ろうとしています。
指定したセルに入力された内容に対応して、数パターンのメッセージまたは図形を結果のセルに表示させたいと思っているのですが、セルへの図の表示方法が分かりません。
あるセルへの入力結果に対応して図を表示する方法が知りたいのですが。
なるべく簡単単純だとうれしいです。
(文字列の表示はIF関数を使おうと思っています)
よろしくお願いします。

Aベストアンサー

こんにちは

 A1:A10のセル内にそれぞれ一つづつ図が入っているとします。

 まずは名前定義です。

1.Ctrl+F3(メニュー[挿入]-[名前]-[定義]
3.[名前]に Pic と入力
4.[参照範囲]に=INDIRECT($G$1) と入力
5.[OK]ボタンをクリック

 セルG1に A1 と入力しておきます。

 続いて、図のリンク貼り付けです。

1.セルA1を選択(オートシェイプではなく、セルA1を選択)してCtrl+C(コピー)
2.セルH1を選択して、Shiftキーを押しながらメニュー[編集]-[図のリンク貼り付け]
3.数式バーに =Pic と入力

 これで、セルG1に、A2 とか A3 のようにアドレスを入力してみてください。

参考URL:http://www2.odn.ne.jp/excel/

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Q条件にマッチする行を抽出するVBAを教えてください

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だけのリストとなり、印刷するだけでいいようにしたいわけです。

本来ならオートフィルタですればいい話ですが、どうしてもD3という離れたセルの入力内容で抽出したいのです。

VBAでなく、D3のセル内容を使ってD8~のオートフィルタが行えるなら、それが一番理想です。
が、自分でやってみた限りはできませんでした。

フィルタオプションならどうかとやってみたところ、一回目は抽出できました。しかし、D3またはE3の条件を変更しても、リアルタイムで抽出結果が切り変わらない。
フィルタオプションの抽出結果を別のセルに出せばいいのですが、そうすると無駄な情報が残り、ただ印刷しただけでOK・・というわけにいきません。(印刷範囲を区切るとかでなく、シートの見栄えが必要な情報だけにならないと…扱う初心者が混乱します)


自分なりには、VBAにより、 D3・E3のセル内容が書き換わったらフィルタオプションの抽出結果をいったん同シートの別セルに出し、抽出結果部分だけを別のシートにカット&ペースト成形。そのシートを印刷させればよい。
という考えになりましたが、やってみたら、なぜか別のブックに同じものが形成され、抽出した結果だけ単独のデータにできません。

そもそももっと良いアイデアがあればそれをおしえていただきたい。
あるいは、VBAで目的達成できるように問題点をご指摘ください。


一応、プログラムを書いておきます



■添付画像のデータが入っているシート(『一覧』という名前のシート)内コード

Private Sub Worksheet_Change(ByVal Target As Range)
'

If Target.Column = 4 Then
If Target.Row >= 3 And Target.Row <= 3 Then

Call Filter
Call copy

End If
End If

End Sub

■サブルーチンFilter() 標準モジュールに記載
Sub Filter()

' Filter Macro

'フィルタオプションを使って同シート内「D1100」以降に抽出結果を出します
ActiveWorkbook.Worksheets("一覧").Select

'一覧表はD7~F1000。検索条件はD2~F3までの範囲に名前を付けたもの
Range("一覧表").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"検索条件"), CopyToRange:=Range("D1100"), Unique:=False

Range("A1").Select
End Sub


■サブルーチンcopy() 標準モジュールに記載
Sub copy()
'
' copy Macro
'
'抽出された内容(45行目~100行目まで)を別のシートにコピーします

ActiveWorkbook.Worksheets("一覧").Select
Rows("45:100").Select
Selection.Cut
ActiveWorkbook.Worksheets("抽出結果").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Range("A1").Select


End Sub

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だ...続きを読む

Aベストアンサー

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼び出した画面に書き込み、入力が終わったら、ファイルタブ→終了してexcelに戻る、としてください。

それと、クライテリアを使うと、倉庫1の検索で倉庫10以降もピックアップされてしまうので、1は全角で10以降は半角にするなど、元ネタに区別をしてください。

また、利用者のなかにビギナーがいるのであれば、セルのロックと保護を使い、一覧シートのD3:E3しか操作出来ないようにする、入力規則を使って、商品1,商品2といったリストから選ばせる、等の工夫も考えられます。それらをどう併用するかによって適切なコードも変わってきますので、細部はご自身で調整してください。

Private Sub Worksheet_Change(ByVal Target As Range)

If Application.Intersect(Target, [D3:E3]) Is Nothing Then Exit Sub

Worksheets(”抽出結果”).[A1:C1000].ClearContents

Range(”一覧表”).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
(”検索条件”), Copytorange:=Worksheets(”抽出結果”).Range(”A1”)

End Sub

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング