Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9559 / 76807

←次へ　｜　前へ→


	【72810】Re:スピンボタンの表示

ume - 12/9/20(木) 17:59 -


	引用なし

	パスワード

UO3 さんへ
下記のようにしました
UO3 のご指示でうまく動いております

Option Explicit

Dim shデータ As Worksheet
Dim レコード数 As Long
Dim 行 As Long

Private Sub UserForm_initialize()
　　Dim x As Long
　
　　ComboBox1.List = _
　　　　Array("省略")
　　ComboBox2.RowSource = "Sheet1!B1:B12"

　　TextBox1.Value = Worksheets("Sheet1").Range("N11").Value '備考
　　TextBox4.Value = Worksheets("Sheet1").Range("I11").Value '日にち

　　Set shデータ = Worksheets("新築工事台帳")
　　レコード数 = shデータ.Range("A1").CurrentRegion.Rows.Count - 1
　
　　If レコード数 = 0 Then
　　　　MsgBox "データがないので実行できませんよ～～"
　　　　SpinButton1.Enabled = False
　　　　Exit Sub
　　End If

　　With SpinButton1
　　　　.Max = レコード数
　　　　.Min = 1
　　End With
　　
　　TextBox5.Value = x & "/" & レコード数
　　
　　
　　Calendar1.Value = Date

End Sub

Private Sub ComboBox2_Change()
　　Dim i As Long
　　Dim myArray As Variant
　　Dim z As Variant
　
　　With ComboBox2
　　　　z = Application.Match(.Text, Evaluate(.RowSource), 0)
　　End With
　
　　If IsNumeric(z) Then
　　　　TextBox1.Value = Worksheets("Sheet1").Range("N" & z).Value
　　　　TextBox4.Value = Worksheets("Sheet1").Range("I" & z).Value
　　
　　　　CBSet False　　　　　　　　 'まずすべてオフ
　　
　　　　Select Case z
　　　　　　Case 1
　　　　　　　　CBSet True　　　　　'工事開始のお知らせすべてTrue
　　　　　　Case 2
　　　　　　　　CBSet 2, 19, 35　　 '地鎮祭のお知らせ
　　　　　　Case 3
　　　　　　　　CBSet 3, 4, 18　　　'仮設ﾄｲﾚ、水道、電気依頼
　　　　　　Case 4
　　　　　　　　CBSet 1, 34　　　　 'ｺﾝﾃﾅ設置依頼
　　　　　　Case 5
　　　　　　　　CBSet 1, 3, 4, 8, 9, 10, 16, 17 '業者打合せ
　　　　　　Case 6
　　　　　　　　CBSet 20, 22　　　　'FRP 及び防蟻　工事依頼
　　　　　　Case 7
　　　　　　　　CBSet 3, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17 '木工事終了及びｺﾝﾃﾅ撤去依頼
　　　　　　Case 8
　　　　　　　　CBSet 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 24, 34　 '足場払い日程連絡
　　　　　　Case 9
　　　　　　　　CBSet 3, 4, 7, 8, 9, 10, 11, 12, 13, 16, 17, 23　　 '清掃のお知らせ
　　　　　　Case 10
　　　　　　　　CBSet 1, 3, 4, 17, 23　　　 '社内検査日程連絡
　　　　End Select
　　End If
　　If ComboBox2.Text = Worksheets("Sheet1").Range("B1").Value Then '工事開始のお知らせ
　　　　Calendar1.Visible = False
　　　　
　　Else
　　　　Calendar1.Visible = True
　　End If
　　　　
End Sub

Private Sub CommandButton1_Click()
　　Dim myMSG As String
　　Dim myFlg As Boolean
　　Dim x As Long
　　Dim r As Long
　　Dim c As Long
　　Dim z As Long
　　Dim i As Long

　　Worksheets("FAX送信のご案内").Range("H12").Value = ComboBox1.Value '送信者転記
　　Worksheets("FAX送信のご案内").Range("C16").Value = ComboBox2.Value '用件転記
　　Worksheets("FAX送信のご案内").Range("A19").Value = TextBox4.Value '日にち項目転記
　　Worksheets("FAX送信のご案内").Range("C20").Value = TextBox1.Value '備考転記
　　Worksheets("FAX送信のご案内").Range("C21").Value = TextBox2.Value '備考転記
　　Worksheets("FAX送信のご案内").Range("C23").Value = TextBox3.Value '備考転記
　　Worksheets("FAX送信のご案内").Range("C19").Value = Format(Calendar1.Value, "ggge年mm月dd日(aaa)") 'ｶﾚﾝﾀﾞｰから摘出
　　Worksheets("FAX送信のご案内").Range("C17").Value = TextBox7.Value + "邸　新築工事" '工事名転記
　　Worksheets("FAX送信のご案内").Range("C18").Value = TextBox8.Value '工事場所転記
　　Worksheets("FAX送信のご案内").Range("H17").Value = TextBox9.Value '監督名転記

　　If Calendar1.Visible = False Then '工事開始のお知らせ
　
　　　　Worksheets("FAX送信のご案内").Range("C19:I19").ClearContents
　　　　Worksheets("FAX送信のご案内").Range("C19:I19") = TextBox10.Value
　　Else
　　　　Calendar1.Visible = True

　　End If

　　i = SpinButton1.Value + 1
　　myFlg = False
　　Sheets("FAX送信のご案内").Range("B2:I10").ClearContents

　　For x = 1 To 35 'ﾁｪｯｸﾎﾞｯｸｽの番号
　　　　If Me.Controls("CheckBox" & x).Value = True Then
　　　　　　myMSG = myMSG & Me.Controls("CheckBox" & x).Caption & vbCrLf
　　　　　　myFlg = True
　　　　　　z = z + 1
　　　　　　r = ((z - 1) \ 4) + 2
　　　　　　c = (((z - 1) Mod 4) + 1) * 2
　　　　　　Sheets("FAX送信のご案内").Cells(r, c).Value = Sheets("新築工事台帳").Cells(i, x + 5).Value
　　　　End If
　　Next x

　　If myFlg = True Then
　　　　myMSG = myMSG & "宛てで宜しいですか?"
　　　　If MsgBox(myMSG, vbInformation + vbYesNo) = vbYes Then
　　　　　　Me.Hide
　　　　　　ActiveWindow.ActiveSheet.PrintPreview
　　　　　　Me.Show vbModeless
　　　　End If
　　Else
　　　　myMSG = "いずれにもチェックが入っていません"
　　　　MsgBox myMSG
　　End If

End Sub

Private Sub CommandButton2_Click()

　　Worksheets("FAX送信のご案内").PrintOut

End Sub

Private Sub SpinButton1_Change()

　　データ表示 SpinButton1.Value

End Sub

Private Sub データ表示(x As Long)

　　TextBox5.Value = x & "/" & レコード数
　　TextBox6.Value = shデータ.Range("A" & x + 1).Value
　　TextBox7.Value = shデータ.Cells(x + 1, 2).Value
　　TextBox8.Value = shデータ.Cells(x + 1, 3).Value
　　TextBox9.Value = shデータ.Cells(x + 1, 4).Value
　　TextBox10.Value = shデータ.Cells(x + 1, 41).Value

End Sub

Private Sub CBSet(ParamArray idx())
　　'　: True　すべて True
　　'　: Fasle すべて False
　　'　: n,n,n Trueにする番号
　
　　Dim x As Variant
　　Dim fg As Boolean
　　Dim ck As Long
　　Dim myColor As Long
　
　　myColor = &H0&
　　ck = CLng(idx(0))
　
　　If ck = -1 Then
　　　　fg = True 'True
　　　　myColor = &HFF&
　　End If
　
　　For x = 1 To 35　'CheckBox1～CheckBox35
　　　　Me.Controls("CheckBox" & x).Value = fg
　　　　Me.Controls("CheckBox" & x).ForeColor = myColor
　　Next
　
　　If ck < 1 Then Exit Sub 'すべてTrueまたはFalse
　
　　For Each x In idx
　　　　Me.Controls("CheckBox" & x).Value = True
　　　　Me.Controls("CheckBox" & x).ForeColor = &HFF&
　　Next

End Sub

現在、新築工事台帳には２行目と３行目にデーターが入っています
１行目はタイトル行です
ユーザーフォームを開いたとき0/2になってしまいます
出来たらですが2/2（最終行）にすることはできますでしょうか

よろしくお願い申し上げます

2 hits

▼

【72745】スピンボタンの表示 ume 12/9/14(金) 14:20