このコードをダブルクリックにて、実行するには？

質問

ブック「集計」の「貼り付け元のワークシート」のどこかをダブルクリックして、ブック「集計E　」へ貼り付けたいのですが、どうも、うまくいきません。
１、このブック「集計E 」が、同フォルダで、同ウインドウにある場合。
２、別ウインドウにある場合も可能でしたら、ご教示下さいませ。

ちなみに、下記コードは、「貼り付け元のワークシート」内で、コピ＆ペにて「行列の入れ替え」をしてから、再度、コピ＆ペにて「集計E　」へ貼り付けております（他の方法を知りませんので）。

どうぞ、よろしくお願い致します。
-----------
Sub DoubleClick()

Range("B3:M11").Select
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Selection.Cut
Windows("集計E.xls").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("集計.xls").Activate

End Sub
----------

回答No.5

Wendy02 · ベストアンサー

Wendy02です。

以下は、コードを替えてみました。

ダブルクリックをお望みなら、Call して呼べばよいと思います。
私としては、本来は、これではいけない部分（エラーが出る)があるとは思いますが、これ以上は余計なお世話なので、もう、しょうがないです。

'------------------------------------
Sub CopyData2()
　'データ転送マクロ
　Dim ChkVal As Variant
　Dim ChkFlg As Boolean
　'=================================================
　'ユーザー設定
　Const MBK_RAGNE As String = "B3:M11" 'コピー元範囲
　'
　Const OBK_NAME As String = "集計E.xls" 'コピー先ブック名
　Const OSH_NAME As String = "Sheet1" 'コピー先シート名
　'=================================================
　On Error GoTo ErrHandler
　'コピー先ブックが開いているか、シートがあるか二重チェック
　ChkVal = Windows(OBK_NAME).Caption
　ChkVal = Workbooks(OBK_NAME).Sheets(OSH_NAME).Name
　'窓を開く
　Call WindowDividing(OBK_NAME)
　'ここは不要なら、コメントアウト

　With ThisWorkbook
　　.ActiveSheet.Range(MBK_RAGNE).Copy
　　Workbooks(OBK_NAME).Worksheets(OSH_NAME).Range("B65536").End(xlUp).Offset(1). _
　　PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
　　SkipBlanks:=False, Transpose:=True
　　Application.CutCopyMode = False
　　MsgBox "別ブックへ貼り付けました！"
　　'保存
　　'Workbooks(OBK_NAME).Close True
　　'ActiveWindow.WindowState = xlMaximized　'最大化
　End With
　Exit Sub
ErrHandler:
　If Err.Number = 9 And ChkFlg = False Then
　　'ブックを開ける
　　Workbooks.Open (OBK_NAME)
　　Err.Clear
　　ChkFlg = True
　　Resume Next
　Else
　　'想定されていないエラー
　　MsgBox Err.Number & ": " & Err.Description, vbCritical
　End If
End Sub
Sub WindowDividing(Bk_Name As String)
Dim w As Window
　For Each w In Windows
　　If w.Visible = True Then
　　　If Not (w.Caption = Bk_Name Or w.Caption = ThisWorkbook.Name) _
　　　　Then
　　　　w.WindowState = xlMinimized
　　　Else
　　　　w.WindowState = xlNormal
　　　End If
　　End If
　Next
　Windows.Arrange ArrangeStyle:=xlVertical
End Sub

'------------------------------------------------------------

ご質問とは離れますが、ある人は、コンピュータに関して、私に「どんなものでも、良く分からないものは、使うべきではない」と言われました。ただ、今のプログラミング事情というのは、「良く分からないもの」という前提で作られていますから、作っている本人も理解できないところがあります。「オブジェクト指向」もそのうちだと思います。

それと、インターネット掲示板に出ているものは、相手が著作権をいくら主張しても、その主張は無効です。私などは、自分のものでオリジナリティの強いものはすぐに分かります。

その人個人を特定とする固有の情報が含まれていなければ主張できません。本にでもしなければ、著作権は主張できません。

自分より力の上の人がいれば、心の中で、尊敬と感謝すればよいと思います。もしくは、心のライバル（心の友？)でもよいと思います。私は、数年前は、VBAはおろか、プログラミングに関して、まったく素人でしたが、VBAを知らないことで、某掲示板でとても悔しい思いをさせられたことがあり、それを一念発起で、VBAを覚えました。^^;

私などは、そんなことがなければ覚えませんでした。
VBA上級を目指すというのは、また別の問題（すなわちお金)がありますが・・・。

参考になるか分かりませんが・・・。

回答No.6

Wendy02

Wendy02です。補足

#5は、誤解を受けるといけないので、
>これではいけない部分（エラーが出る)があるとは思いますが、
>これ以上は余計なお世話なので、もう、しょうがないです。

通常、画面のWindowを割ったら、そのWindowをひとつにして元に戻す、ということをしないと、本来はいけない、ということです。ただ、そのためには、画面の状態を最初、保管しておかなくてはなりません。「結果オーライ」ということもありますが、同じ結果でも、プロセスの違いは、経験の違いなので、ご理解ください。

あまり、こちらの身勝手な想定の上に、コードを継ぎ足すのは、コードを分かりにくくする、ひとつになるので、これ以上は、やめておこう、と書いたまでです。うまく書けずにすみませんです。

お礼

詳細な、ご説明、誠に有難うございます。
＞　Selection.Cut
すみません、当初、質問前は、この様に何の気なしに、記録しただけで、
質問後に、も一度記録しましたら、今度は　Copy　で切り取れたので、Copy　としました。

Windowの「左右に並べて表示」もバッチリでした。

基本が身についていないまま、前へ進んで行ってしまっている状況ですので、
意味不明なことをしてて、大変申し訳ございません。

でも、おかげ様で、少しずつですが、理解できるようになってきております。
やっぱり、人それぞれ、きっかけというものが、大きく左右することにもなるんですね。

回答No.4

Wendy02

こんにちは。Wendy02です。

>3点だけ、ご教示下さいませ。

少し、戸惑っています。

返事を書いて気が付いたのですが、「３、回答No.2の「回答に対する補足」の私の「Sub 別ブックへ()」と、最初のご質問と途中で換えたのですか？

　Selection.Cut

があるのと、ないのでは大きくないようが変わります。

>1回の実行結果は、よく似ていると、初心者には思ってしまいますので！

それは、禁句かな。^^;　たとえ話をすれば、乗り物を違っていても、目的地に行くこと自体変わらない、といえば、それはそれまでなのです。大きく違う点は、開発スタイルが違うといえば、言い訳に聞こえるかもしれませんが。データの確保している場所が違います。

一応、回答No.2の「回答に対する補足」に、内容を切り替えるつもりです。

>1 は、コマンドボタン追加　Sub CommandButton_Add()　は、標準モジュールなら、同じモジュールに置けばよいです。一応、知らないまま、別の標準モジュールにおいてもよいように、Private キーワードを付けないで、Sub CopyData()　とは書きましたが。

回答No.3

Wendy02

こんにちは。Wendy02です。

やはり、「同ウィンドウ」は、両方を見開きした形であるのは、確認しやすいのですが、Windowをマクロで表現すると、意外とややこしく面倒です。理由は、Windowインデックスが、固定ではないからです。

以下は、わたし流の考えで作ったもので、コピー元の範囲の設定などは、ユーザー設定部分をまとめ挙げたのですが、これでは、まだ、キメウチ状態ですから、不満が残ります。おそらく、実用段階にはまだ至ってはいないと思います。設計としては、こんな風ではどうか、と考えました。

本来は、ユーザー設計の部分をダイアログボックス(UserFormではありません)を付けてあげるとよいのですが、それは、掲示板では教えることは難しいです。

それに、ツールボタンも作成してみました。なお、このボタンは、ツールバー上に載っていますから、フローティングして、別の場所に移動することが可能です。通常では、上部下段に配置されるはずです。

細かい部分などは、また考えるとして、とりあえず、「集計.xls」の標準モジュールに貼り付けて、CommandButton_Add を試してみてください。

'-----------------------------------------------------
'以下二つとも標準モジュールのみ

Sub CopyData()
　'データ転送マクロ(Transpose)
　Dim ChkVal As Variant
　Dim vntAry As Variant
　Dim i As Long, j As Long
　'=================================================
　'ユーザー設定
　Const MBK_RAGNE As String = "B3:M11" 'コピー元範囲
　'
　Const OBK_NAME As String = "集計E.xls" 'コピー先ブック名
　Const OSH_NAME As String = "Sheet1" 'コピー先シート名
　Const OADD As String = "B3" 'コピー先アドレス左端上
　'=================================================
　'データ元のチェック
　　If WorksheetFunction.CountA(ActiveSheet.Range(MBK_RAGNE)) = 0 Then
　　　 MsgBox "データがありません。データ元を確認してください。" & vbCrLf & "終了します。", vbInformation
　　　 Exit Sub
　　End If

　On Error GoTo ErrHandler
　'コピー先ブックが開いているかチェック
　ChkVal = Workbooks(OBK_NAME).Sheets(OSH_NAME).Range(OADD).Value
　If ChkVal <> "" Then
　　If MsgBox("コピー先にはすでに値がありますが、上書きしますか？", vbInformation + vbOKCancel) = vbCancel Then
　　　 Exit Sub
　　End If
　End If

　With ThisWorkbook
　　.Activate
　　'配列に代入
　　vntAry = ActiveSheet.Range(MBK_RAGNE).Value
　　ActiveSheet.Range(MBK_RAGNE).ClearContents
　　With Workbooks(OBK_NAME)
　　　For i = LBound(vntAry, 1) To UBound(vntAry, 1)
　　　　For j = LBound(vntAry, 2) To UBound(vntAry, 2)
　　　　　.Worksheets(OSH_NAME).Range(OADD).Cells(j, i).Value = vntAry(i, j)
　　　　Next j
　　　Next i
　　End With
'以下二者択一　'.Activate は、元のブック, Application は、コピー先ブック
'.Activate
Application.Goto Workbooks(OBK_NAME).Sheets(OSH_NAME).Range(OADD)
　End With
　Exit Sub
ErrHandler:
　If Err.Number = 9 Then
　　Workbooks.Open (OBK_NAME)
　　Resume
　　Err.Clear
　End If
End Sub
'--------------------------------------------------------------------
コマンドボタン追加
'--------------------------------------------------------------------
Sub CommandButton_Add()
　'メニューにボタン付け
　Dim myCBCtrl As CommandBarControl
　Dim mySubCB As CommandBarControl
　Dim myCBC As CommandBar

　'DELOPT=Trueにしてマクロを実行すれば、ボタンは削除できます。
　Const DELOPT As Boolean = False
　'ユーザーメニューは、最初に、メニュー削除を置き、二重登録させないようにする

　On Error Resume Next
　　　Application.CommandBars("ユーザーメニュー").Delete
　On Error GoTo 0
　If DELOPT = True Then Exit Sub
　Set myCBC = Application.CommandBars.Add(Name:="ユーザーメニュー", _
　　　　　　　Position:=msoBarTop, Temporary:=True)
　Set myCBCtrl = myCBC.Controls.Add(Type:=msoControlButton)

　With myCBCtrl
　　.Caption = "データ転送(&D)"
　　.BeginGroup = False
　　.TooltipText = "データ転送をします"
　　.FaceId = 531
　　.OnAction = "CopyData"
　End With

myCBC.Visible = True
Set myCBCtrl = Nothing
Set myCBC = Nothing

End Sub

補足

ご詳細なご回答、どうも有難うございます。
初心者で、基本をまだ知らない上で、難しいことを希望したようです。
3点だけ、ご教示下さいませ。
１、「Sub CopyData()」「Sub CommandButton_Add()」
は、それぞれ、別々の標準モジュールに貼り付け実行すればよろしいですね？
２、＞Const OADD As String = "B3" 'コピー先アドレス左端上
　　　Const OADD As String = "B65536".End(xlUp).Offset(1, 0)
　　のように、してみたのですが、エラーになってしまいますが、どのように
　　編集すればよろしいのでしょうか？
３、回答No.2の「回答に対する補足」の私の「Sub 別ブックへ()」
と、「Sub CopyData()」は、コードがかなり違いますが、書式コピーは別としまして、どのような大きな相違点（Sub CopyData()のメリット）が、おありでしょうか？
1回の実行結果は、よく似ていると、初心者には思ってしまいますので！
以上、よろしくお願い致します。

回答No.2

Wendy02

こんばんは。お話が良く見えませんね。

>１、このブック「集計E 」が、同フォルダで、同ウインドウにある場合。
>２、別ウインドウにある場合も可能でしたら、ご教示下さいませ。

「同フォルダ」というのはファイルのロケーションですから、意味が分かりますが、同ウィンドウという「ウィンドウ」は、Excelのウィンドウしか事実上ありませんから、よく理解できません。それは、左右に開くのか上下に開くのか別としても、別に同ウィンドウでも別ウィンドウでも、開いている限りは、あまり関係がないように思います。

別フォルダで、そのファイル自体を探さなくてはならない、という意味なら、その意味が通ります。

また、ダブルクリックということ自体も、なぜ、ダブルクリックなのか、戸惑いを感じます。

例えば、ツールボタンとして、ツールバーやメニューバーに置いて、マクロを登録するとか、また、ショートカットにするとか、右クリックメニューにするとか、方法がいろいろあるのに、それを選ぶ理由が分かりません。

別な言い方をすると、ダブルクリック・イベントというのは、Rangeオブジェクトの引数があるように、特定のシートのクリックしたセルの処理のために使うのであって、できないわけではありませんが、ひとつのイベントに使ってしまうというのは、あまり芳しい方法ではないように思います。

なお、Paste:=xlPasteAll　となっているところをみると、書式もコピーということですね。

補足

どうも有難うございます。
自身でいろいろためしてみましたら(No.1様のも)、おっしゃられる通り、該当シートだけしか実行ができないようですね！　
どうも不都合のようです、でも大変参考になりました。
＞同ウィンドウ
うまく表現できませんが、1つのEXCELウインドウで2つ以上のブックを開く。　　　　　　　　　　　　
＞別ウインドウ
　前記へ更に、新しいもお1つのEXCELウインドウを開きブックを開く。（両方共に1度に画面が見られる）
＞なお、Paste:=xlPasteAll　…
私がマクロを記録しましたら、このように記述されただけですが、項目と数字です。　

ということで、何とか編集しました下記コードを「別ウインドウのブック　集計Ex　」
へ貼り付けることはできますでしょうか？
（両方共に1度に画面が見られるほうが作業するのに、しやすいと思ったからです）
よろしくお願い致します。
-----------
Sub 別ブックへ()
Range("B3:M11").Select
Selection.Copy
Windows("集計Ex.xls").Activate

Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
MsgBox "別ブックへ貼り付けました！"
End Sub

回答No.1

merlionXX

ブック「集計」の「貼り付け元のワークシート」のシートモジュール（標準モジュールではありません）に以下をコピペしてから、「貼り付け元のワークシート」のどこかをダブルクリックしてみてください。

同じフォルダー内にある"集計E.xls"（閉じておいてください）の1枚目のシートに貼り付けます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
pt = ThisWorkbook.Path
Range("B3:M11").Copy
Set wb = Workbooks.Open(pt & "\集計E.xls")
wb.Sheets(1).Range("B3:J14").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
'wb.Close
ThisWorkbook.Activate
End Sub

お礼

遅くなりまして、申し訳ございません。
ご回答者様の、内容を理解するのに、まだまだ、時間がかかってしまっております。
バッチリ、実行できました。
誠に、有難う、ございます。