• 締切済み

CheckBoxとTextBoxの値を貼付る方法

よろしくお願いします。 Dim n As Long Dim r As Range Dim C, buf As String n = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & n).Select For Each C In Controls If TypeName(C) = "CheckBox" Then If C.Value Then buf = buf & C.Caption & vbCrLf End If Next C ActiveCell.Offset(-1, 16).Value = buf & TextBox9.Value ’buf=チェックされている複数のCheckBoxのCaption ’この時のActiveCell.Offset(-1, 16).ValueにはbufとTextBox9の値も表示されています。 End If で、セルに入力して ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(-1, 16).Value で、セルに貼り付けようとすると、bufの値のみ表示されてTextBox9の値が表示されません。 bufの値とTextBox9の値と両方をコピー表示する方法をお教えください。

  • 1211M
  • お礼率54% (90/165)

みんなの回答

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

コード的に間違っているようには見えません。 ・・・TextBox9.Valueに何があるのかは別として ただ >で、セルに入力して これは >ActiveCell.Offset(-1, 16).Value = buf & TextBox9.Value この”代入”を意味しているのか、それとも他の何かなのかがわからなかったです。 仮にどうしてもダメなら ActiveCell.Offset(0, 7).Value = buf & TextBox9.Value 同じ事をすればよい。 場合によってはセルに値が入る事で変化(書式とか数値と数字の違いetc)して しまっているなら、こっちの方が確実なのかも。

関連するQ&A

  • Excel VBAフォーム 登録ボタンの作成方法

    いつもお世話になっています。 初めて、Excelのフォームで入力画面を作りました。 複数の項目があって、それを最後に[登録]ボタンをクリックで 表に入れたいのですが、一度にまとめて実行する方法が分かりません。 アドバイスよろしくお願いいたします。 Private Sub cmd_1() Dim i As String If man.Value = True Then ActiveCell = man.Caption End If If woman.Value = True Then ActiveCell = woman.Caption End If ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_2() Dim i As String If man.Value = True Then ActiveCell = Yes.Caption End If If woman.Value = True Then ActiveCell = No.Caption End If ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_downlist() Dim ListNo As Long ListNo = group.ListIndex ActiveCell.Value = group.List(ListNo, i) ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_comment() ActiveCell = comment.Text ActiveCell.Offset(1, -3).Select End Sub

  • checkboxの値の取得方法

    教えてください (excel2010) checkboxをセルRange("C1")から下方に10個作成しています。(下方を参照) 質問は2点あります。 [質問1]  10個のセルにcheckboxは作成されるのですが、この後、これらに設定したセルの値(Check on/off)を判定するには、どのようコーディングすればよいのでしょうか? [質問2] 10個のセル作成時、当初 ".LinkedCell=" で指定したセルに「True/False」が表示されていましたが、現在以下の処理を行っても「True/False」が表示されません。 確認事項や対処方法にお心あたりがあれば、ご教授願います。  '------------------------------------------ checkbox 10個作成 Dim myChk As Object Dim i As Long Dim 個数 As Long Dim 開始セル As Range 個数 = 10               'チェックボックス作成数 Set 開始セル = Range("C1")   'チェックボックス作成の開始セル位置 For i = 0 To 個数 - 1 With StartCell.Offset(i) Set myChk = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _ DisplayAsIcon:=False, _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) End With With myChk .LinkedCell = 開始セル.Offset(i, 1).Address .Object.Caption = "" .Object.Value = False End With Next

  • A2の値がA1の値と同じ場合はB2にB1の値+1をして

    A2の値がA1の値と同じ場合はB2にB1の値+1をして A2の値がA1の値と違う場合はB2に"1"を繰り返しさせて入力するように 以下としたのですが、A列の値がなくなる限り1が入力されるだけなのですが どうすれば、A列のセルに同じ値が続く場合連番とすることができるでしょうか。お願いします。 range("B1").value = 1 range("B2").select dim 番号 As varient 番号 = activecell.offset(-1, -1).value do until activecell.offset(0,-1).value = "" with activedell if offset(0, -1).value = 番号 then offset(0, 0).value = offset(-1, 0).value + 1 end if offset(0, 0).value = "1" offset(1, 0).select end with loop

  • VBA リストボックスの値をセルに転記

    よろしくお願いします。 したいことは、 ユーザーフォームのリストボックスで複数の値を選んで複数セルに転記する。 ActiveCell.offset(10, 5) ⇐ リストボックスで選んだ1つ目 ActiveCell.offset(11, 5) ⇐ リストボックスで選んだ2つ目 ActiveCell.offset(12, 5) ⇐ リストボックスで選んだ3つ目 下の構文では1つしか転記できません。 Dim n As Integer, s As String For n = 0 To ListBox3.ListCount - 1 If ListBox3.Selected(n) Then s = s & ListBox3.List(n) & vbCrLf ActiveCell.offset(10, 5).Value = s End If Next

  • 処理速度を速くする方法教えてください。

    Private Sub CommandButton1_Click() Dim irow As Long Dim Celldata(1 To 6) As Double Dim ekimen(1 To 6) As String '高さ読込み If TextBox8.Value = "" Then MsgBox ("No.を入力") End End If If TextBox9.Value = "" Then MsgBox ("温度を入力") End End If If TextBox10.Value = "" Then MsgBox ("係数を入力") End End If Celldata(1) = TextBox1.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(2) = TextBox2.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(3) = TextBox3.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(4) = TextBox4.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(5) = TextBox5.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value Celldata(6) = TextBox6.Value + (TextBox7.Value - TextBox9.Value) * TextBox10.Value '入力と修正 Dim i As Long '最終行から試験Noが一致するものを探す For i = 65535 To 6 Step -1 If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then Set myrange = Sheets("データ").Cells(i - 1, 1) '記入セルがoffset(1,x)になっているため、i-1にしています。 Exit For End If Next i 'Noが一致しない場合、最終行を記入セルに設定する。 If i = 5 Then Set myrange = Sheets("データ").Range("A65536").End(xlUp) End If 'ワークシートへの転記 With myrange .Offset(1, 0).Value = TextBox8.Value '----No. .Offset(1, 1).Value = Celldata(1) '----1計測 .Offset(1, 2).Value = Celldata(2) '----2計測 .Offset(1, 3).Value = Celldata(3) '----3ル計測 .Offset(1, 4).Value = Celldata(4) '----4計測 .Offset(1, 5).Value = Celldata(5) '----5計測 .Offset(1, 6).Value = Celldata(6) '----6計測 .Offset(1, 13).Value = TextBox1.Value '----1追加 .Offset(1, 14).Value = TextBox2.Value '----2追加 .Offset(1, 15).Value = TextBox3.Value '----3追加 .Offset(1, 16).Value = TextBox4.Value '----4追加 .Offset(1, 17).Value = TextBox5.Value '----5追加 .Offset(1, 18).Value = TextBox6.Value '----6追加 .Offset(1, 19).Value = TextBox7.Value '---温度 .Offset(1, 20).Value = TextBox11.Value '----1高さ .Offset(1, 21).Value = TextBox12.Value '----2高さ .Offset(1, 22).Value = TextBox13.Value '----3高さ .Offset(1, 23).Value = TextBox14.Value '----4高さ .Offset(1, 24).Value = TextBox15.Value '----5高さ .Offset(1, 25).Value = TextBox16.Value '----6高さ '入力ボックスのクリア TextBox1.Value = "" '----1セル TextBox2.Value = "" '----2セル TextBox3.Value = "" '----3セル TextBox4.Value = "" '----4セル TextBox5.Value = "" '----5セル TextBox6.Value = "" '----6セル TextBox7.Value = "" '---温度 TextBox11.Value = "" '----1セル TextBox12.Value = "" '----2セル TextBox13.Value = "" '----3セル TextBox14.Value = "" '----4セル TextBox15.Value = "" '----5セル TextBox16.Value = "" '----6セル End With 'lblComment.Caption = "ワークシートに転記しました!" End Sub Private Sub CommandButton2_Click() Dim i As Long '入力チェック If TextBox8.Value = "" Then MsgBox ("No.を入力") End End If If TextBox9.Value = "" Then MsgBox ("温度を入力") End End If If TextBox10.Value = "" Then MsgBox ("係数を入力") End End If For i = 65535 To 6 Step -1 If CStr(Cells(i, 1)) = Trim(TextBox8.Value) Then Set myrange = Sheets("データ").Cells(i - 1, 1) '記入セルがoffset(1,x)になっているため、i-1にしています。 Exit For End If Next i '受付No.がない場合、終了します。 If i = 5 Then MsgBox ("No.が見つかりません") End End If '入力の処理と逆の処理を行います。 With myrange TextBox1.Value = .Offset(1, 13).Value '---1計測 TextBox2.Value = .Offset(1, 14).Value '---2計測 TextBox3.Value = .Offset(1, 15).Value '---3計測 TextBox4.Value = .Offset(1, 16).Value '---4計測 TextBox5.Value = .Offset(1, 17).Value '---5計測 TextBox6.Value = .Offset(1, 18).Value '---6計測 TextBox7.Value = .Offset(1, 19).Value '---温度 TextBox11.Value = .Offset(1, 20).Value '---1高さ TextBox12.Value = .Offset(1, 21).Value '---2高さ TextBox13.Value = .Offset(1, 22).Value '---3高さ TextBox14.Value = .Offset(1, 23).Value '---4高さ TextBox15.Value = .Offset(1, 24).Value '---5高さ TextBox16.Value = .Offset(1, 25).Value '---6高さ End With End Sub

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • Excel ユーザーフォーム呼び出し時エラー

    WindowsVista HomePremium Excel 2007 Microsoft Visual Basic 6.5 です。 Excelでユーザーフォーム(UserForm1)を作り、   Sub Auto_Open()     UserForm1.Show   End Sub で起動時に呼び出すようにしました。 確認のため、一度Excelを閉じ起動し直したところ正常に動作しました。 もう一度確認のため同じように再起動をすると、  実行時エラー '2110': コントロールが表示されていない、利用できない、またはフォーカスを持てないため、そのコントロールにフォーカスを移すことはできません。 と出て、それ以降何度やっても動作しなくなってしまいました。 解決法か原因がわかる方いらっしゃいましたら、ぜひご教授ください。よろしくおねがいします。 ユーザーフォーム関係のコードを以下に書いておきます。(内容は小遣い帳のようなものです。) ―――――――――――――――――――― Private Sub CommandButton1_Click() Dim NUM As Integer If TextBox1.Text = "" Then MsgBox "概要が記入されていません。" TextBox1.SetFocus GoTo 100 ElseIf TextBox2.Text = "" Then MsgBox "収支が記入されていません。" TextBox2.SetFocus GoTo 100 ElseIf ComboBox1.ListIndex = -1 Then MsgBox "収支の種類が選択されていません。" ComboBox1.SetFocus GoTo 100 End If Range("F6").Select NUM = 0 Do While ActiveCell.Offset(NUM, 0) <> "" NUM = NUM + 1 Loop ActiveCell.Offset(NUM, 0).Select ActiveCell = TextBox1.Value If CheckBox1 = True Then TextBox2 = -TextBox2 End If If ComboBox1.ListIndex = 0 Or ComboBox1.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox1.ListIndex + 1) = TextBox2.Value Else ActiveCell.Offset(0, ComboBox1.ListIndex + 2) = TextBox2.Value End If TextBox1 = "" TextBox2 = "" CheckBox = Falses ComboBox1.ListIndex = -1 100 End Sub ―――――――――――――――――――― Private Sub CommandButton2_Click() Dim NUM As Integer If TextBox3.Text = "" Then MsgBox "移動金額が記入されていません。" TextBox3.SetFocus GoTo 100 ElseIf ComboBox2.Text = "" Then MsgBox "移動元が選択されていません。" ComboBox2.SetFocus GoTo 100 ElseIf ComboBox3.ListIndex = -1 Then MsgBox "移動先が選択されていません。" ComboBox3.SetFocus GoTo 100 End If Range("F6").Select NUM = 0 Do While ActiveCell.Offset(NUM, 0) <> "" NUM = NUM + 1 Loop ActiveCell.Offset(NUM, 0).Select ActiveCell = "移動" If ComboBox2.ListIndex = 0 Or ComboBox2.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox2.ListIndex + 1) = -TextBox3.Value Else ActiveCell.Offset(0, ComboBox2.ListIndex + 2) = -TextBox3.Value End If If ComboBox3.ListIndex = 0 Or ComboBox3.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox3.ListIndex + 1) = TextBox3.Value Else ActiveCell.Offset(0, ComboBox3.ListIndex + 2) = TextBox3.Value End If TextBox3 = "" ComboBox2.ListIndex = -1 ComboBox3.ListIndex = -1 100 End Sub ―――――――――――――――――――― Private Sub CommandButton3_Click() Unload Me End Sub ―――――――――――――――――――― Private Sub CommandButton4_Click() Unload Me End Sub ―――――――――――――――――――― Private Sub UserForm_Initialize() myarray1 = Array("収支", "クレジット", "郵便局", "机", "500", "1") For i = 0 To 5 ComboBox1.AddItem myarray1(i) ComboBox2.AddItem myarray1(i) ComboBox3.AddItem myarray1(i) Next i TextBox1.SetFocus End Sub

  • エクセル VBAのチェックボックスについて

    お読みくださり、ありがとうございます。 エクセル初心者でございます。 エクセルのマクロなのですが、 お詳しい方、是非教えて欲しいです!汗 調子に乗って入力フォームなるものを作りました。 入力フォームの中にて、チェックボックスで「ある」「なし」の項目を入れてみたのですが、チェックしていないのに、値が入る現象が起きています汗 以下、素人が書いたコードを恥を承知で記載させていただきます。 Private Sub CheckBox1_Click() If CheckBox1.Value = True Then OK = "○" End If End Sub Private Sub CheckBox2_Click() If CheckBox2.Value = True Then NO = "×" End If End Sub Private Sub UserForm_Click() End Sub '以下のコードは、登録ボタンがクリックされたときの処理! Private Sub 登録ボタン_Click() If TextBox1.Text = "" Then MsgBox "グッズ名を入力してください。" Exit Sub End If If TextBox2.Text = "" Then MsgBox "アプローチ先を入力してください。" Exit Sub End If With Worksheets("協賛グッズ") With Cells(Rows.Count, 2).End(xlUp) .Offset(1, 0).Value = TextBox1.Text .Offset(1, 1).Value = mori .Offset(1, 2).Value = mori2 .Offset(1, 3).Value = TextBox2.Text .Offset(1, 5).Value = TextBox3.Text .Offset(1, 6).Value = TextBox4.Text .Offset(1, 7).Value = TextBox5.Text .Offset(1, 8).Value = TextBox6.Text End With End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" CheckBox1.Value = False CheckBox2.Value = False End Sub 以上です。 おかしなところ満載かと思いますが、 チェックを入れた項目だけ値を入れたいと考えております。 おわかりになるかたおりましたら何卒お助けください汗 よろしくお願いいたします。

  • オートフィルタでデータを抽出する方法

    今ある下のコードを実行すると、 別のシートに表示はされるのですが、 同じデータしか表示されない状態です これをすべての条件のヒットするデータを 表示して、別シートにコピーしたいのですが・・・ レイアウトは、 使用者名 メーカー 車種 ナンバー   初年度登録   車検日   備考 です A列の「使用者名」のところに同じ「使用者名」で、それ以降のB列の内容が違うデータが 複数あるので、「使用者名」が同じデータは、すべて表示されるようにしたいのですが、 これ以上どうしたらいいかわかりません。 つたない説明で大変申し訳ないのですが、ご教授願います Sub CommandButton1_Click() Dim 使用者名 As Variant Dim cnt As Variant With Worksheets(3) .Select .Range("A6").AutoFilter _ Field:=7, _ Criteria1:="=" & UserForm4.TextBox1, Operator:=xlAnd .Range("A6").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("出力").Range("A6") End With Worksheets("出力").Activate Columns("A:O").EntireColumn.AutoFit With ActiveSheet.UsedRange MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row End With cnt = 6 For 基点 = 1 To MaxRow MsgBox (基点 & "です") 'まず検索用テキストボックスの中に文字の入力があるかどうかをチェックします。 If Not txtsiyousya.Value = Empty Then '氏名の列であるA列の中に検索する氏名があるかどうかをチェックします。 Set 使用者名 = Columns("A:A").Find(txtsiyousya, LookIn:=xlValues) '検索結果が発見できれば、そのセルをアクティブにします。 If Not 使用者名 Is Nothing Then 使用者名.Activate Unload UserForm2 UserForm4.TextBox1.Text = ActiveCell.Offset(0, 0).Value UserForm4.TextBox2.Text = ActiveCell.Offset(0, 1).Value UserForm4.TextBox3.Text = ActiveCell.Offset(0, 2).Value UserForm4.TextBox4.Text = ActiveCell.Offset(0, 3).Value UserForm4.TextBox5.Text = ActiveCell.Offset(0, 4).Value UserForm4.TextBox6.Text = ActiveCell.Offset(0, 5).Value UserForm4.TextBox7.Text = ActiveCell.Offset(0, 6).Value UserForm4.TextBox8.Text = ActiveCell.Offset(0, 7).Value UserForm4.TextBox9.Text = ActiveCell.Offset(0, 8).Value UserForm4.TextBox10.Text = ActiveCell.Offset(0, 9).Value UserForm4.TextBox11.Text = ActiveCell.Offset(0, 10).Value UserForm4.TextBox12.Text = ActiveCell.Offset(0, 11).Value UserForm4.TextBox13.Text = ActiveCell.Offset(0, 12).Value UserForm4.TextBox14.Text = ActiveCell.Offset(0, 13).Value UserForm4.Show cnt = cnt + 1 MsgBox (cnt) '検索結果が発見できなければ、次のメッセージを表示します。 Else MsgBox "検索した使用者は登録されていません" txtsiyousya.Value = Empty End If Else MsgBox "検索する使用者を入力して下さい" End If Next 基点 Range("A6").AutoFilter Field:=1, Criteria1:=UserForm4.TextBox1.Text Worksheets("出力").Activate Worksheets("ライフ").Activate End Sub

  • excel vbaでの質問になります

    このようなマクロを作成したのですが、セルに数式が入れてあると、どうしてもその下の空白の行に値を入力されてしまいます。 数式が入っているセルにもそのままセルに値を入れたいのですが・・ 宜しくお願いします。 Dim wb1 As Worksheet, r1 As Range Dim N As Integer, i As Integer Dim mycount As Long   Set wb1 = ThisWorkbook.Worksheets("請求書") mycount = Range("B111").CurrentRegion.Rows.Count Cells(111 + mycount, 2).Select ActiveCell.Offset(0, 0).Value = wb1.Range("C60").Value ActiveCell.Offset(0, 1).Value = wb1.Range("C61").Value ActiveCell.Offset(0, 12).Value = wb1.Range("C66").Value ActiveCell.Offset(0, 13).Value = wb1.Range("C74").Value ActiveCell.Offset(0, 14).Value = wb1.Range("C75").Value ActiveCell.Offset(0, 15).Value = wb1.Range("C84").Value ActiveCell.Offset(0, 16).Value = wb1.Range("C85").Value ActiveCell.Offset(0, 20).Value = wb1.Range("C69").Value ActiveCell.Offset(0, 22).Value = wb1.Range("C68").Value ActiveCell.Offset(0, 23).Value = wb1.Range("C76").Value ActiveCell.Offset(0, 24).Value = wb1.Range("C77").Value Exit Sub

専門家に質問してみよう