午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

エクセル2007で値貼り付けのマクロで：１のウィンドウのシートが勝手に切り替わる

エクセルExcel2007 #Windows
 2014年3月13日追記
エクセル2007値貼り付けのマクロの不具合を修正 - 午後わてんのブログ - Yahoo!ブログ
↓にあるマクロを修正したものが↑2014年3月13日追記ここまで
 
 

エクセル2007

右クリックメニューから形式を選択して貼り付けからよく使うのが値で
4回もクリックするのがめんどくさくてマクロにしたんだけど
新しいウィンドウで開くで複数のウィンドウがある状態で
値貼り付けのマクロで実行するとシートが勝手に切り替わってしまうので
どうにかしようという話
 

f:id:gogowaten:20191014135358p:plain

実行するマクロは値だけを貼り付けるものでたった一行
Selection.PasteSpecial Paste:=xlPasteValues
 

f:id:gogowaten:20191014135423p:plain

：1がついた方のウィンドウのシートの表示が値貼り付けをしたウィンドウと
同じシートに勝手に切り替わってしまう
PasteSpecialをつかうとこうなるみたいで
これはエクセル2000のときもあった
切り替わったのなら元に戻せばいいじゃないってことでの力技
 

f:id:gogowaten:20191014135447p:plain

Sub 値貼り付け()
    '新しいウィンドウで複数のウィンドウを開いていると
    ':1のついたウィンドウのシートが勝手に切り替わるので
    'それを元に戻すから長くなった
    Dim fmt
    fmt = Application.ClipboardFormats
    If fmt(1) Then 'クリップボードが空ならなにもしないで終了
       Exit Sub
    End If
    
    If Application.CutCopyMode = xlCut Then
        MsgBox ("切り取りでは実行できないのでコピーで実行して")
        Exit Sub
    End If
    Application.ScreenUpdating = False
    
    
    Dim actS As Worksheet '貼り付け先のシート、アクティブシート
    Dim actN ':1のウィンドウのアクティブシートの名前
    Dim bName 'ブックの名前
    Dim wName '貼り付け先のウィンドウの名前
    Dim allW 'ウィンドウすべて、新しいウィンドウで開くで開かれているウィンドウ
    Dim val
    
    Set actS = ThisWorkbook.ActiveSheet
    bName = ActiveWorkbook.Name
    wName = Application.ActiveWindow.Caption
    
    ':1を探して新しいウィンドウで開くで複数ウィンドウがあるかどうかの判定
    Set allW = ActiveWorkbook.Windows
    For Each c In allW
'        val = Right(c.Caption, 2)
'        val = c.Caption
        If Right(c.Caption, 2) = ":1" Then
            actN = c.ActiveSheet.Name
            Selection.PasteSpecial Paste:=xlPasteValues '値貼り付け
            
        ':1がつくウィンドウのアクティブシートを元に戻す
            Application.Windows(c.Caption).Activate
            Worksheets(actN).Activate
            
            Application.Windows(wName).Activate '貼り付け先のウィンドウをアクティブにする
            Application.ScreenUpdating = True
            Exit Sub
        End If
    Next
    
    '複数ウィンドウがなければ貼り付けて終わり
    '貼り付け
    Selection.PasteSpecial Paste:=xlPasteValues
 
    Application.ScreenUpdating = True
    
    
End Sub
 

f:id:gogowaten:20191014135643p:plain

期待通りの動きになった
行列を入れ替えての値貼り付けなら
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
 
右クリックメニューに直接値貼り付けのボタンを登録するのもありだなと今思った
 
 
 
 
関連記事
2017/01/29は2年10ヶ月後
右クリックメニューに値貼り付け、書式貼り付け、行列を入れ替えて貼り付けを追加する記事
ボタンの名前からコントロールIDを探すマクロ、IDを使ってセルの右クリックメニューに既存のボタン追加 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14711160.html