[[20090604214009]]　『VBAで自動作成したチェックボックスの横の文字を普x（こけもも）　ページの最後に飛ぶ

『VBAで自動作成したチェックボックスの横の文字を変えるには』（こけもも）

[[20080821125615]]でチェックボックスを作成するセルの範囲と対応するリンク先の
セルの範囲を設定をすると自動的にリンク先を指定したチェックボックスを作るVBA
コードが出ていたので、使ってみましたが、作成したチェックボックスの横に
"チェック１"、"チェック２"というように文字が出てきます。
(たくさんチェックボックスを作ったので、実際は"チェック737"というように出ます）

上記の方法でチェックボックスを作成した時に自動的に出てくる"チェック１"というような
文字を"済"という字で出てくるようにするにはどうすればよいのでしょうか。

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

 こんにちは。かみちゃん　です。

 > VBA コードが出ていたので、使ってみました

 どのコードを使っておられるのかわかりませんが、
[[20080821125615]]
 でichinoseさんが紹介されているコードであれば、
   With mkrng.Parent.CheckBoxes.Add(crng.Left, _
                     crng.Top, _
                     crng.Width, _
                     crng.Height)
 の次の行に
     .Characters.Text = "済"
 を記述すればできると思います。

 (かみちゃん)
 2009-06-06  1:32

 こけももさんがＶＢＡなんか殆ど興味はないので、抱えている問題（多数のチェックボックスに
 同じCaptionを付けたい）が解決できればよい　と言うことであれば、かみちゃんさんの
 方法で解決してください（これは、嫌味ではないですよ、価値観の問題です。私もちょっと前に
 虫にはそれほど興味はないですが、虫の掲示板である虫のことだけが知りたくて投稿しました。
 ヨコヅナサシガメ　って言う虫）。

 でも、ＶＢＡ（プログラミング）の上達のために本気で取り組んでおられるのなら・・・、

  .Characters.Text = "済"

 という変更では、他のCaptionを指定したい場合は、また、コードを変更しなければなりません。
 どこかでも書きましたが、
 プログラムを変更するのは、仕様の変更時であって、データの変更時ではありません。

 こんなコードにしてみました。

 標準モジュールに

 '==================================================================================
 Sub main()
    Dim mkrng As Range
    Dim lnkrng As Range
    Dim crng As Range
    Dim mcell() As Variant
    Dim g0 As Long
    Dim caformula As Variant
    Dim ans As Variant
    Dim g1 As Long
    Dim ele As Variant
    Dim result() As Variant
    Set mkrng = get_sctrng("チェックボックスを作成するセル範囲を選択してください")
    If Not mkrng Is Nothing Then
       Set lnkrng = get_sctrng("対応するリンクセル範囲を選択してください")
       If Not lnkrng Is Nothing Then
          caformula = Application.InputBox("項目名を数式形式で指定して下さい")
          If TypeName(caformula) <> "Boolean" Then
             ans = Application.Evaluate("=" & caformula)
             If TypeName(ans) = "Variant()" Then
                g1 = 1
                For Each ele In ans
                   ReDim Preserve result(1 To g1)
                   result(g1) = ele
                   g1 = g1 + 1
                Next
             End If
          End If
          g1 = 1
          g0 = 1
          For Each crng In mkrng
             With mkrng.Parent.CheckBoxes.Add(crng.Left, _
                               crng.Top, _
                               crng.Width, _
                               crng.Height)
                .LinkedCell = lnkrng.Cells(g0).Address(, , , True)
                If TypeName(caformula) <> "Boolean" Then
                   If TypeName(ans) = "Variant()" Then
                      .Caption = result(g1)
                      g1 = g1 + 1
                   Else
                     .Caption = Application.Evaluate(caformula)
                   End If
                End If
                If g0 < lnkrng.Count Then g0 = g0 + 1
                End With
             Next
       End If
    End If
 End Sub
 '==================================================================================
 Function get_sctrng(Optional mes As String, Optional mxact As Long = 1) As Range
    Dim rng As Range
    Dim retcode As Long
    On Error Resume Next
    retcode = 1
    Set get_sctrng = Nothing
    Do Until retcode = 0
       Set rng = Application.InputBox(mes, , , , , , , 8)
       If Err.Number = 0 Then
          If rng.Areas.Count <= mxact Then
             Set get_sctrng = rng
             retcode = 0
             End If
       Else
          retcode = 0
          End If
       Loop
    On Error GoTo 0
 End Function

 使用方法

 新規ブックにて試してください。

 mainを実行してください。

 「チェックボックスを作成するセル範囲を選択してください」という入力ダイアログが表示されます。

 仮に　A1:A3を指定して下さい（直接セルを選択することも可能です）。
 チェックボックスを作成するセル範囲の選択が完了したら、ＯＫボタンを押してください。

 次に「対応するリンクセル範囲を選択してください」という入力ダイアログが表示されます。
 今度は、B1:B3を指定して下さい（直接セルを選択することも可能です）。
 チェックボックスにリンクするセル範囲の選択が完了したら、ＯＫボタンを押してください。

 次に「項目名を数式形式で指定して下さい」という入力ダイアログが表示されます。
 全てのチェックボックスの項目名を　済　にしたいなら

 "済"  両端の「"」も含めて指定する

 とセルに数式を入力する場合と同じ形式で指定して下さい。
 これでＯＫボタンをクリックすると、済と言う項目名の付いたチェックボックスが3つ作成されます。

 同じようにmainを実行して、
 チェックボックスを作成するセル範囲として、　A10:A13、
 対応するリンクセル範囲として、　　　　　　　b10:b13,

 項目名を数式形式で指定して下さい では、　　"未"&row(A10:A13)-9

 なんて指定すると、それぞれ

 未1
 未2
 未3
 未4

 と言う項目名を持つ4つのチェックボックスが作成されます。

 試してみてください。

 ichinose@ちょっと訂正

かみちゃんさん、希望通りできました！
どうもありがとうございます。

ichinoseさん、どうもありがとうございます。
仕事で使用している表にチェックボックスを作成しているのですが、
毎月数十行追加していくのに、これまでは前に作成したチェックボックスを
コピーし、それに対応するリンク先を右クリックで一つずつ変更していたので、
とても時間がかかっていました。
なので、今はichinoseさんのプログラムのおかげで大変助かっています。
当面はかみちゃんさんの方法で大丈夫なのですが、これだと別の表でもいろいろと
応用できます。ありがとうございます。
VBA頑張って勉強します！

（こけもも）

コメント返信：

[ 一覧(最新更新順) ]

[[20090604214009]] 『VBAで自動作成したチェックボックスの横の文字を普x（こけもも） ページの最後に飛ぶ

[[20090604214009]]　『VBAで自動作成したチェックボックスの横の文字を普x（こけもも）　ページの最後に飛ぶ