| |
▼ume さん：
とりあえずコードの不要なところ（と思われるところ）を消し、１つにできるところは１つに。
といった変更を行いました。ロジック自体はかえていません。ComboBox2に対してChange１イベントのほかに
Clickイベントがあるのはなぜかな？とも思いますが、そこも変えていません。
ユーザーフォームモジュールをすべていれかえて、ここからスタートしませんか？
これをベースにして、umeさんの意図通りになっていないところをチューニングしていきましょう。
Option Explicit
Dim shデータ As Worksheet
Dim レコード数 As Long
Private Sub UserForm_initialize()
Dim x As Long
ComboBox1.List = _
Array("Aさん", "Bさん", "Cさん", "Dさん", "Eさん", "Fさん", "Gさん", "Hさん", "Iさん", "Jさん", "Kさん", "Lさん")
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
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
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 '工事開始のお知らせ '★Falsee
Worksheets("FAX送信のご案内").Range("C19:I19").ClearContents
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 ComboBox2_Click()
If ComboBox2.Text = Worksheets("Sheet1").Range("B1").Value Then '工事開始のお知らせ
Calendar1.Visible = False
Worksheets("FAX送信のご案内").Range("C19:I19").ClearContents
Else
Calendar1.Visible = True
End If
End Sub
Private Sub データ表示(x As Long)
TextBox5.Value = x & "/" & レコード数
TextBox6.Value = shデータ.Range("A" & x + 1).Value
TextBox10.Value = Worksheets("新築工事台帳").Cells(SpinButton1.Value, 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
|
|
UO3
- 12/9/19(水) 15:07 -
