Excel VBA質問箱 IV

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

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


9501 / 76732 ←次へ | 前へ→

【72793】Re:スピンボタンの表示
発言  UO3  - 12/9/19(水) 15:07 -

引用なし
パスワード
   ▼ume さん:

とりあえずコードの不要なところ(と思われるところ)を消し、1つにできるところは1つに。
といった変更を行いました。ロジック自体はかえていません。ComboBox2に対してChange1イベントのほかに
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
1 hits

【72745】スピンボタンの表示 ume 12/9/14(金) 14:20 質問
【72746】Re:スピンボタンの表示 UO3 12/9/14(金) 22:06 発言
【72766】Re:スピンボタンの表示 ume 12/9/18(火) 11:07 質問
【72767】Re:スピンボタンの表示 UO3 12/9/18(火) 12:24 発言
【72771】Re:スピンボタンの表示 ume 12/9/18(火) 17:47 質問
【72772】Re:スピンボタンの表示 UO3 12/9/18(火) 19:19 発言
【72768】Re:スピンボタンの表示 UO3 12/9/18(火) 13:07 発言
【72769】Re:スピンボタンの表示 UO3 12/9/18(火) 13:29 発言
【72787】Re:スピンボタンの表示 ume 12/9/19(水) 10:31 質問
【72788】Re:スピンボタンの表示 ume 12/9/19(水) 10:34 質問
【72789】Re:スピンボタンの表示 ume 12/9/19(水) 10:37 質問
【72790】Re:スピンボタンの表示 UO3 12/9/19(水) 11:36 発言
【72791】Re:スピンボタンの表示 ume 12/9/19(水) 13:39 質問
【72792】Re:スピンボタンの表示 UO3 12/9/19(水) 14:45 発言
【72795】Re:スピンボタンの表示 ume 12/9/19(水) 15:41 発言
【72793】Re:スピンボタンの表示 UO3 12/9/19(水) 15:07 発言
【72797】Re:スピンボタンの表示 ume 12/9/19(水) 16:24 お礼
【72799】Re:スピンボタンの表示 ume 12/9/19(水) 18:07 質問
【72800】Re:スピンボタンの表示 UO3 12/9/19(水) 20:44 発言
【72801】Re:スピンボタンの表示 UO3 12/9/19(水) 20:56 発言
【72810】Re:スピンボタンの表示 ume 12/9/20(木) 17:59 質問
【72815】Re:スピンボタンの表示 UO3 12/9/20(木) 21:28 発言
【72819】Re:スピンボタンの表示 ume 12/9/21(金) 13:13 お礼

9501 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free