Excel VBA質問箱 IV

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

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


9484 / 76732 ←次へ | 前へ→

【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


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

よろしくお願い申し上げます
0 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 お礼

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