• 締切済み

CutCopyMode範囲の取得方法について。

Application.CutCopyMode=True時の対象セル範囲を取得したく思っています。 対象セルが記憶されているオブジェクト、または、 CutCopyMode=True時のイベントがわかればよいのですが見つかりません。 只今、SelectionChangeにて一時保管して使用していますが、Mode対象セル範囲を次から次へと変更していくと、この方法では上手く取得できません。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.CutCopyMode <> xlCopy And _ Application.CutCopyMode <> xlCut Then Set 一時保管 = Selection End If End Sub イベントまたはオブジェクトご存知の方宜しくお願い致します。

みんなの回答

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

#1 のWendy02です。補足です。 今自分の書いたものを読んでいて、ミスを発見したのですが、CutCopyMode の点線枠とSelection とは、一致しませんね。ClipBoard に入っているか入っていないかですね。ClipBoard には、Excel用のものと、Windows用のものと、ActiveX コントロールのDataObject の三つがあって、ユーザーが一番使いやすいのは、DataObjectですが、これは、テキストオンリーです。

i_september
質問者

お礼

ご回答ありがとう御座います。 参考にさせて頂きます。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.1

こんばんは。Wendy02です。 最初に、 Application.CutCopyMode <> xlCopy And _ Application.CutCopyMode <> xlCut Then ロジックとしては、And じゃなくて、Or じゃないのかなって思いますが、イベント自体が、SelectionChange で、Set 一時保管 = Selection としても、 Dim 一時保管 As Range として、モジュールレベルの変数か、Public としてグローバル変数にしなければ、End Sub でお終いになってしまいますね。 その溜めたものを吐き出す時に、どういうことになるのかっていうことで、入れる方には、イベントは、あまり手順はいらないと思います。あえて必要になるのは、吐き出し時に、Selection 自体をどのように加工するか、ということが重要鍵になるのか、と思います。つまり、同じシート内なら、再び SelectionChange イベントが働いてしまうので、それを回避することも考えなくてはなりません。

関連するQ&A

  • 複数のセルを選択しているかを取得するプロパティは?

    SelectionChangeイベントで 複数のセルを選択しているかを取得するプロパティってないのでしょうか? 今は、 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Len(Target.Address) > 5 Then MsgBox "複数のセルが選択されています" End If End Sub こうしていますが、行数が多くなると文字も多くなってしまうので、このコードでは対応できません。 Rangeオブジェクトに何個セルが入ってるかを知る方法はありますか? ウォッチのTargetのcellsを見ても、どう見ればいいのかわかりません

  • イベントを起こすと画面が揺れまくって大変です・・・結構見栄えもきついので回避できないでしょうか?

    以前ワークシートのイベントのプログラムを教えていただきありがとうございました。 参考に作ったプログラムなのですが・・・範囲をもう少しだけでかくしてやると画面がゆれて困っています。 値を入れてコピーしているときが特にひどいです。 複数セルを選択して消去しても大丈夫なようにかつ揺れない方法はないでしょうか? Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim r As Range For Each r In Target MyProc r Next End Sub Sub MyProc(Target As Range) Dim i As Long Application.EnableEvents = False If Selection.Cells.Count <> 1 Then Exit Sub ' 変更したセルに値が入った場合条件成立 If Trim(Target.Value) <> "" Then ' 行番号が10以上65530以内のとき条件成立 If Target.Row >= 10 And Target.Row <= 65530 Then ' BCD列で、5の倍数の行のとき条件成立 If (Target.Column >= 2) And (Target.Column <= 4) Then If (Target.Row Mod 5) = 0 Then If Target.Value <> "" Then For i = 0 To 4 Target.Copy Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues Next If (Target.Column = 2) Then Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1) End If End If Else Exit Sub End If End If End If Application.CutCopyMode = False End If Application.EnableEvents = True End Sub

  • VBA 範囲選択時エラー

    Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー  型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub

  • 空白状態でEnterを押したら指定のセルに飛びたい

    例えばF5セルで何も入力せずEnterを押したらC9に入力セルを飛ばしたくて 自分の力で調べた限りでは下のコードで可能なのですが Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Range("F5,C9") If Not Intersect(Target(1), .Cells) Is Nothing Then Application.EnableEvents = False .Select Target(1).Activate Application.EnableEvents = True End If End With End Sub 上記コードはF5セルを選ぶと、次に飛ぼうとするC9セルが見えてしまいます。 これが見えずにできる他の方法があるか色々調べても見つかりませんでした; 何か可能な策はありますでしょうか・・?

  • 非表示の列があるか取得したい。

    Sub Macro1() Columns("a").Hidden = True End Sub としたら、A列が非表示になりますよね。 そして、セル全体に非表示の列があるかどうかを取得したい場合はどうすればいいでしょう? Sub Macro2() If Cells.Hidden = True Then MsgBox "非表示の列があります" End If End Sub をすると、実行時エラー1004になります。 それに Cells.Hiddenの時点で、列だけじゃなくなってしまいます。 あと、最終列はファイルによってまちまちです。 Z列の時もあれば、EAの時もあります。 ご回答よろしくお願いします。

  • 「更新後処理」のようなものはありますか?

    エクセルのシートのイベントで、「更新後処理」のようなものはありますか? 例えば、 該当のセルに「あ」という文字を入力したのなら、「あああ」にする という事をしたいのですが、 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Value = "あ" Then Target.Value = "あああ" End If End Sub これだと、「あ」を入力しただけでは、何も起こらず、 その入力したセルをクリック(入力したセルに移動)すると、「あああ」になります。 これだと2度手間になるので、「あ」が入力されたと同時に、イベントを発生させたいのですが どのイベントを使えばいいのでしょうか?

  • excel2002vbaで選択しているセルがハイパーリンクとそれ以外のものを区別する方法

    ハイパーリンクをenterキーでリンク先に飛べるようにマクロを挿入したのですが、ハイパーリンク以外のセルでenterキーを押下した時に、「インデックスが有効範囲にありません」というエラーメッセジが表示されていまい通常のセル移動が行えません。 使用しているマクロは以前に掲載されていた以下のマクロをしようしています。 何かいい方法はあるでしょうか? Sub Auto_Open() '起動時 キー設定 On Call SettingKeys(True) End Sub Sub Auto_Close() '終了時 キー設定 Off Call SettingKeys(False) End Sub Sub SettingKeys(flg As Boolean) If flg Then Application.OnKey "{Enter}", "JumpHyperLink" Application.OnKey "~", "JumpHyperLink" Else Application.OnKey "{Enter}" Application.OnKey "~" End If End Sub Sub JumpHyperLink() If TypeName(Selection) = "Range" Then Selection.Hyperlinks(1).Follow NewWindow:=False End If End Sub

  • エクセルVBA:取得したファイル情報を別シートに貼るには・・・

    いつもお世話になっています。 今エクセルVBAで指定したフォルダ内のファイル情報を取得し、sheet2に貼り付けるものを作っています。 指定したフォルダ内のファイル情報を取得するまでは分かったのですが、作ったVBAを実行するとsheet1のA2セルから自動的に貼り付けられてしまいます。 sheet2のA1セルから貼り付けるにはどうすれば良いのでしょうか?? 作ったVBAはこんな感じです。 まず、フォルダのパスを取得しA2セルへ表示します。 Sub test2()  With Application.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then Exit Sub Range("A2").Value = .SelectedItems(1) End With End Sub 次に、A2セルの値を使ってファイル名を取得しました。 Sub Test() Dim i As Long Dim pass As String pass = Range("A2").Value With Application.FileSearch .NewSearch .LookIn = pass .FileType = msoFileTypeAllFiles .SearchSubFolders = True If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i + 1, 1) = .FoundFiles(i) Cells(i + 1, 3) = FileDateTime(.FoundFiles(i)) Next i End If End With End Sub です。 長くて申し訳ありません。よろしくお願いします。

  • エクセルを起動すると、Visual Basic !無効なオブジェクトラ

    エクセルを起動すると、Visual Basic !無効なオブジェクトライブラリです。または定義されていないオブジェクトへの参照を含んでいます。と警告され。BOOK名 BenriQAT.basと言うbookが自動的に開き、Attribute VB_Name = "MD_QATBENRI" Option Explicit Const Benri As String = "便利ツール.xls!" Private Sub Auto_Open() Application.OnTime Now + TimeValue("0:0:2"), ThisWorkbook.Name & "!Start_Proc" End Sub Private Sub Start_Proc() Dim wb As Workbook Application.ScreenUpdating = False ThisWorkbook.Saved = True If ThisWorkbook.ReadOnly = False Then ThisWorkbook.ChangeFileAccess xlReadOnly ThisWorkbook.IsAddin = False ThisWorkbook.Windows(1).Visible = False ThisWorkbook.Saved = True For Each wb In Application.Workbooks If wb.Windows(1).Visible = True Then Exit For End If Next If wb Is Nothing Then Workbooks.Add End If Set wb = Nothing Application.ScreenUpdating = True End Sub Public Sub QAT_はんこ設定() Application.Run Benri & "CMD_はんこ設定" End Sub Public Sub QAT_押印1() Application.Run Benri & "CMD_押印1" End Sub Public Sub QAT_押印2() Application.Run Benri & "CMD_押印2" End Sub Public Sub QAT_押印3() Application.Run Benri & "CMD_押印3" End Sub Public Sub QAT_目次作成() Application.Run Benri & "CMD_目次作成" End Sub Public Sub QAT_ページ設定情報一覧() Application.Run Benri & "CMD_ページ設定情報一覧" End Sub Public Sub QAT_ページ設定情報複写() Application.Run Benri & "CMD_ページ設定情報複写" End Sub Public Sub QAT_一括取り込み() Application.Run Benri & "CMD_一括取り込み" End Sub Public Sub QAT_一枚取り込み() Application.Run Benri & "CMD_一枚取り込み" End Sub Public Sub QAT_ピクセル_列幅行高() Application.Run Benri & "CMD_ピクセル_列幅行高" End Sub Public Sub QAT_数式セルのロック() Application.Run Benri & "CMD_数式セルのロック" End Sub Public Sub QAT_結合セルを含む範囲の値複写() Application.Run Benri & "CMD_結合セルを含む範囲の値複写" End Sub Public Sub QAT_結合セルの行高の自動調整() Application.Run "CMD_結合セルの行高の自動調整" End Sub Public Sub QAT_セル内改行のあるセルの列幅自動調整() Application.Run Benri & "CMD_セル内改行のあるセルの列幅自動調整" End Sub Public Sub QAT_極細罫線_格子() Application.Run Benri & "CMD_極細罫線_格子" End Sub ・・・・・続く・・と言った文字が毎回出ます。以前便利ツールをインストールしていたせいだと思いますが、直し方が分かりません。オフィスのインストールし直しなどしましたが変わりません。どうすればいいのですか?お願いします。

  • VB6.0でPowerPoint上のイベントを取得したい

    VB6.0からPowerPointのファイルを開き、 PowerPoint上のイベントを取得したいのですが、 方法が分からず困っております。 具体的には、ツールバーのプレビューボタンが クリックされたことをVBで検知したいと考えています。 現状では下記のように、Applicationの閉じるイベントは 取得できたのですが、そこからどうして良いか分からない状態です。 良きアドバイスをお願い致します。 ---------------------------------------------------- Option Explicit Private WithEvents PPTApp As PowerPoint.Application '■パワポを開く Private Sub Command1_Click() Set PPTApp = New PowerPoint.Application PPTApp.Visible = True PPTApp.Presentations.Open (App.Path & "\test.ppt") End Sub '■パワポを閉じる Private Sub Command2_Click() PPTApp.Quit Set PPTApp = Nothing End Sub '■閉じるイベントを取得 Private Sub PPTApp_PresentationClose(ByVal Pres As PowerPoint.Presentation) MsgBox "閉じる" End Sub ----------------------------------------------------

専門家に質問してみよう