Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
フォームコントロールのマクロ
投稿日時: 20/02/25 15:38:50
投稿者: tera1208

やりたいことが二つあります。
@フォームコントロールのチェックボックスにチェックを入れたとき、チェックボックスが位置しているセルに1を入れたい。かつ下にフィルコピーしても相対的に反映させたい。
➁同時に左隣の3列分のセルをコピーして値のみ貼り付けしたい。
 
こんなことはVBAで可能なのでしょうか。
お手数をお掛けしますが、宜しくお願い致します。

回答
投稿日時: 20/02/25 16:33:05
投稿者: WinArrow
投稿者のウェブサイトに移動

tera1208 さんの引用:
やりたいことが二つあります。
@フォームコントロールのチェックボックスにチェックを入れたとき、チェックボックスが位置しているセルに1を入れたい。かつ下にフィルコピーしても相対的に反映させたい。
➁同時に左隣の3列分のセルをコピーして値のみ貼り付けしたい。
 
こんなことはVBAで可能なのでしょうか。
お手数をお掛けしますが、宜しくお願い致します。

 
@には、2つの課題があります。
1つ目は、
>フォームコントロールのチェックボックスにチェックを入れたとき、チェックボックスが位置しているセルに1を入れたい。
ですよね?
 
チェックボックスにマクロを登録すると下谷のようなプロシジャが作成されます。
Sub チェック1_Click()
End Sub
 
このプロシジャは、クリックしたときに起動します。
このプロシジャの中でリンクセルの値を数値に置き換えればよいです。
参考コードを下記します。
Dim chkBox As CheckBox
    Set chkBox = ActiveSheet.CheckBoxes(1)
    ActiveSheet.Range(chkBox.LinkedCell).Value = Abs(ActiveSheet.Range(chkBox.LinkedCell).Value * 1)

 
2つ目の
>かつ下にフィルコピーしても相対的に反映させたい。
は、意味が理解できません。
 
Aは、マクロの記録でコードを作成してみてください。

投稿日時: 20/02/25 17:35:37
投稿者: tera1208

 WinArrow様
早速のご回答ありがとうございます。
私の説明があいまいでご迷惑をお掛けし、申し訳ありませんでした。
 
後出し説明で恐縮です。
 
@通常チェックボックスのリンクさせるセルは絶対参照になっていて、例えばチェックボックスがA1セル、リンクさせるセルもA1セルにした時、A1をコピーしてA2に張り付けても、リンクさせるセルがA1のままでA2になりません。
日々行をコピーして最下行に数十行挿入していく表なので、リンクさせるセルを自動的に変化させたいのです。(1を表示させたいというのは忘れてください。)
 
➁例えばアクティブセルがD5セルのときに、A1セルにあるチェックボックスにチェックをいれてもアクティブセルはD5のままです。これを、チェックを入れたときにアクティブセルがA1になるようにしたいのです。それ以降の処理は WinArrow様のおっしゃる通りマクロの記録で何とかしたいと思います。
 
以上、どうか引き続きご指導お願いできないでしょうか。宜しくお願い致します。

回答
投稿日時: 20/02/25 21:57:45
投稿者: simple

参考にして下さい。一例です。
適宜修正して使って下さい。
 

Sub test()
    Dim cb(1 To 3) As CheckBox
    Dim k As Long
    Dim r As Range
    Dim l#, t#, w#, h#
    For k = 1 To 3
        Set r = Cells(k + 1, "D")
        l = r.Left: t = r.Top: h = r.Height
        Set cb(k) = ActiveSheet.CheckBoxes.Add(l, t + 0.1 * h, 60, 0.8 * h)
        cb(k).Caption = "check " & k
        cb(k).Name = "チェック " & k
        cb(k).OnAction = "setPosition"
    Next
End Sub

Sub setPosition()
    Dim cb As CheckBox
    Set cb = ActiveSheet.CheckBoxes(Application.Caller)
    If cb.Value = 1 Then
        cb.TopLeftCell.Select
    End If
End Sub

投稿日時: 20/02/26 09:45:11
投稿者: tera1208

ご回答ありがとうございます。
simpleさんのコードに自分で調べたものを追加して、やりたいことが出来ました。
若干動きが遅い気がするのですが、変なところありますでしょうか。
 
    Sub チェック1_Click()
     
    Application.ScreenUpdating = False
     
    With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, 0)
    .Value = Not .Value
    End With
     
    Dim cb As CheckBox
    Set cb = ActiveSheet.CheckBoxes(Application.Caller)
    cb.TopLeftCell.Select
 
    If TypeName(Selection) <> "Range" Then Exit Sub
    Selection.EntireRow.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 0).Select
    Application.ScreenUpdating = True
     
    End Sub

回答
投稿日時: 20/02/26 10:31:50
投稿者: simple

あえて申し上げるなら、
・Selectの使用はできるだけ避けたほうがよいのでは?
・.Offset(0,0) はなくてもよいのでは?
・TopLeftCellはRangeを常に返すので、タイプの確認は不要かも。
くらいですかね。最初のものが大きいと思います。

投稿日時: 20/02/26 12:20:28
投稿者: tera1208

余計なものを省いてスッキリしました。
 
大変助かりました。
ありがとうございました。