テキストボックスからの転記

Question

前提・実現したいこと

シートのセルへ保存(テキストボックス→構造体→シート)が中々出来ません。
テキストボックスに入れた値を構造体に格納してセルへ保存したいです。

現在、シートからの出力は出来ていますがこの逆がなかなか出来ません。

シート→構造体→テキストボックス
出力の代入式と左右を逆にしたつもりでも
下記の試したことのようにで記述したような結果になります。

テキストボックス→構造体→シートと
三段階ある処理の書き方のイメージがなかなか思いつかない状態です・・。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Type attendance
starttime As Date
endtime As Date
breakstart As Date
breakend As Date
worktime As Single
note As String
End Type

'以下ユーザーフォーム

Private monthly() As attendance '構造体の配列を宣言

Private Sub CommandButton1_Click() '更新ボタン
Call AttendanceSave
'Call SetAttendance
End Sub

Public Sub AttendanceSave() '保存  セルへの転記
ReDim monthly(1 To 31)

Dim i As Long
For i = 1 To 31
monthly(i).starttime = Cells(i + 1, 3).Value
monthly(i).endtime = Cells(i + 1, 4).Value
monthly(i).breakstart = Cells(i + 1, 5).Value
monthly(i).breakend = Cells(i + 1, 6).Value
monthly(i).worktime = Cells(i + 1, 7).Value
monthly(i).note = Cells(i + 1, 8).Value
Next i

End Sub

Public Sub SetAttendance() '出力

Dim i As Long
Sheets(cmbMonth.Value).Activate
For i = LBound(monthly) To UBound(monthly)
Me.Controls("txtStarttime" & i).Value = monthly(i).starttime
Me.Controls("txtEndtime" & i).Value = monthly(i).endtime
Me.Controls("txtBreakstart" & i).Value = monthly(i).breakstart
Me.Controls("txtBreakend" & i).Value = monthly(i).breakend
Me.Controls("txtWorktime" & i).Value = monthly(i).worktime
Me.Controls("txtNote" & i).Value = monthly(i).note
Next i

End Sub

Private Sub cmbMonth_Change() '月選択プルダウン

Debug.Print cmbMonth.Value
Worksheets(cmbMonth.Value).Select '先に月シートを選択してから
'曜日設定やテキストへの転記をする

SetWeekLabel '曜日設定
Call AttendanceSave '選択したシートデータを構造体配列へ
Call SetAttendance '構造体配列からテキストへ

End Sub

試したこと

Cells(i + 1, 3).Value = Me.Controls("txtStarttime" & i).Value
⇒セルへ入ってもフォームを閉じたり月選択で切り替えると、デフォルトの「00：00」になって消えてしまいます

Cells(i + 1, 3).Value = monthly(i).starttime
⇒テキストボックスはその列全て「00：00」が入り、シートのセルには「12:00:00 AM」が入り、「00：00」を消して違う値を入力して更新ボタン押しても、テキストボックスに入力した値はセルに入らない状態です

monthly(i).starttime = Me.Controls("txtStarttime" & i).Value
⇒構文エラー

補足情報（FW/ツールのバージョンなど）

※画像でシートのセルに入っている値は直入力したものです。

・Private Sub cmbMonth_Change()
の部分の、それぞれcallで呼び出している保存と出力処理はコメントアウトするとエラーになってしまいます。

Answer 1

'ここからフォームモジュール
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Then Exit Sub
Call データ検索
End Sub

Private Sub CommandButton2_Click()
If TextBox1.Text = "" Then Exit Sub
    Call データ入力
End Sub

Private Sub CommandButton3_Click()
If TextBox1.Text = "" Then Exit Sub
Call 修正
End Sub

Private Sub CommandButton5_Click()
Unload Me
End Sub

Private Sub ListBox1_Click()
 Call Lisutクリック
End Sub

Private Sub UserForm_Initialize()
      UserForm1.TextBox1.Text = Date
      Call データ検索
      Call Frame1タイトル '取得したシート名を”2021年mm月"で表示
End Sub

'ここから標準モジュール**********
Sub kidou()
     UserForm1.Show
     Worksheets(1).Select
End Sub
Sub risut作成()
'UserForm1.ListBox1に表示させる設計図的なもの
      Dim i As Long, n As Long
      Dim myDate As Variant
      Worksheets(シート名).Select
      n = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            With UserForm1.ListBox1
                  .ColumnHeads = True 'セル(項目)のタイトル表示
                 .BoundColumn = 1    '規定値
                  .ColumnCount = 8  'セル(項目)列の数
                  .ColumnWidths = "50;50;100;100;100;100;100;100;100" 'セル(項目)列のサイズ
                  .RowSource = "A2:H" & n '*List()は時間シリアル表示だったのでRowSource
            End With
End Sub

Option Explicit
Public 年月日 As Date   '年月日
Public 月 As Long       '月
Public 日 As Long  '日
Public 曜日 As String  '曜日
Public i As Long
Public シート名 As String
Sub sheet選択()
'年月日からどのシートを表示させるか・・*****
     年月日 = UserForm1.TextBox1.Text
    月 = Month(年月日)  '月
   日 = Day(年月日) '日
    曜日 = Format(年月日, "aaa") '曜日
      For i = 2 To Sheets.Count
            If Sheets(i).Name = 月 Then
              シート名 = Sheets(i).Name
      End If
        Next i
End Sub

Option Explicit
'
Sub データ検索()
      Call データ検索1
      Call [ListBox表示].risut作成
      Call [リストクリック].Frame1タイトル
End Sub
Sub データ検索1()
'[データ呼び出し](該当シートから呼び込む**************]
Call [Sheet選択する].sheet選択 '該当シート
'**********************************************************
      Dim n As Long
      Worksheets(シート名).Select
      n = Cells(Rows.Count, 1).End(xlUp).Row
      For i = 2 To n
      If 日 = Cells(i, 1) Then
      With UserForm1
              .TextBox2.Text = Cells(i, 3).Text '就業時間
              .TextBox3.Text = Cells(i, 4).Text  '終業時間
              .TextBox4.Text = Cells(i, 5).Text '休憩時間(始め)
              .TextBox5.Text = Cells(i, 6).Text '休憩時間(終)
              .TextBox6.Text = Cells(i, 8).Text '備考欄
      End With
      End If
      Next i
End Sub

Option Explicit
Dim n As Long, i As Long
Dim WorkRange As Variant
Sub データ入力()
      '入力するシート検索***********
'      年月日からどのシートを表示させるか
      Call [Sheet選択する].sheet選択
      '*******************************
            Worksheets(シート名).Select
            n = Cells(Rows.Count, 1).End(xlUp).Row + 1
         'ここで重複登録をチックする**************
         For i = 2 To n
               If 日 = Cells(i, 1).Value Then MsgBox "すでに登録されています": Exit Sub
            '         ここまで  重複登録をチック**************
          Next i
                        With UserForm1
                          Cells(n, 1).Value = 日
                          Cells(n, 2).Value = 曜日
                          Cells(n, 3).Value = .TextBox2.Text
                          Cells(n, 4).Value = .TextBox3.Text
                          Cells(n, 5).Value = .TextBox4.Text
                          Cells(n, 6).Value = .TextBox5.Text
                          Cells(n, 8).Value = .TextBox6.Text  '備考欄
                      End With
                       '***日付順に並べ替え****
                         Call 日付順
                         '************************
                         '即ListBoxに表示させる為「データ検索」
                    Call [データ呼び出し].データ検索1
                     MsgBox "入力しました"
      
'         Worksheets(1).Select
End Sub
Sub 日付順()
'***マクロの記録********
'日付順に並べ替え
    Worksheets(シート名).Select
    n = Cells(Rows.Count, 1).End(xlUp).Row
       Range(Cells(2, 1), Cells(n, 8)).Select
    ActiveWorkbook.Worksheets(シート名).Sort.SortFields.Clear
     ActiveWorkbook.Worksheets(シート名).Sort.SortFields.Add2 Key:=Range(Cells(2, 1), Cells(n, 1)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(シート名).Sort
        .SetRange Range(Cells(2, 1), Cells(n, 8))
        .Header = xlGuess
        .Apply
    End With
    Range("A2").Select
End Sub
'
Option Explicit
Dim ListNo As Long
Dim n As Long
Dim ii As Long
Dim a As String
Dim 年 As String
Sub Lisutクリック()
    ListNo = UserForm1.ListBox1.ListIndex
     Worksheets(シート名).Select
     年月日 = UserForm1.TextBox1.Text
     年 = Year(年月日)
     With UserForm1
     For ii = 1 To 8

     If ii = 3 Then
     a = CDate(.ListBox1.List(ListNo, ii - 1)) '始業時間
    .TextBox2.Text = Left(a, Len(a) - 3)  '"0:00:00"を”0:00”に変換
     If .TextBox2.Text = "0:00" Then .TextBox2.Text = ""
     ElseIf ii = 4 Then
     a = CDate(.ListBox1.List(ListNo, ii - 1)) '終業時間
     .TextBox3.Text = Left(a, Len(a) - 3)
     If .TextBox3.Text = "0:00" Then .TextBox3.Text = ""
     ElseIf ii = 5 Then
     a = CDate(.ListBox1.List(ListNo, ii - 1)) ''休憩始め
     .TextBox4.Text = Left(a, Len(a) - 3)
     If .TextBox4.Text = "0:00" Then .TextBox4.Text = ""
     ElseIf ii = 6 Then
     a = CDate(.ListBox1.List(ListNo, ii - 1)) ''休憩終わり
     .TextBox5.Text = Left(a, Len(a) - 3)
     If .TextBox5.Text = "0:00" Then .TextBox5.Text = ""
     ElseIf ii = 8 Then
     .TextBox6.Text = .ListBox1.List(ListNo, ii - 1) ' '備考欄
     End If
     Next ii
     End With
End Sub
Sub Frame1タイトル()
Dim 年 As String, 年月日 As String, 月 As String
      年月日 = UserForm1.TextBox1.Text
      年 = Year(年月日)
      月 = Month(年月日)
      With UserForm1.Frame2
      .Caption = 年 & "年" & 月 & "月"
      End With
End Sub

Option Explicit
Sub 修正()
Dim WorkRange As Variant
Dim i As Long
  Dim 日 As String
  Dim a As Date
     日 = Day(UserForm1.TextBox1.Text) '日
'     シートのデータを配列に格納（変数＝Variant）
     WorkRange = Worksheets(シート名).UsedRange
  For i = 2 To UBound(WorkRange)
      If WorkRange(i, 1) = 日 Then
      With UserForm1
            WorkRange(i, 3) = .TextBox2.Text
            WorkRange(i, 4) = .TextBox3.Text
            WorkRange(i, 5) = .TextBox4.Text
            WorkRange(i, 6) = .TextBox5.Text
            WorkRange(i, 8) = .TextBox6.Text
            End With
         End If
  Next i
            '変更されたセルをシートに上書き
          Worksheets(シート名).UsedRange = WorkRange
End Sub

Comments

[milk1218]

ご丁寧にありがとうございます・・・！！

参考にさせていただきます！！！

Answer 2

構造体を使う目的がよくわかりませんでしたが、

Option Explicit

Private monthly(1 To 31) As attendance
Private ws As Worksheet

Private Sub FormToSheet_Click()
    Set ws = ThisWorkbook.Worksheets(cmbMonth.Value)
    
    Dim i
    For i = 1 To 31
        monthly(i).starttime = Me.Controls("txtStartTime" & i).Value
    Next
    
    For i = 1 To 31
         ws.Cells(i + 1, 3).Value = monthly(i).starttime
    Next
    
End Sub

Private Sub SheetToForm_Click()
    Set ws = ActiveSheet
    cmbMonth.Value = ws.Name
    
    Dim i
    For i = 1 To 31
        monthly(i).starttime = ws.Cells(i + 1, 3).Value
    Next
    
    For i = 1 To 31
        Me.Controls("txtStartTime" & i).Value = Format(monthly(i).starttime, "hh:nn")
    Next
    
End Sub

Comments

[milk1218]

ありがとうございます！！参考にさせていただきます！

monthly(i).starttime = Me.Controls("txtStartTime" & i).Valueは
私も何度か試したのですが、"型が一致しません"とコンパイルエラーが出てきてしまいます・・。

[jinoji]

If IsDate(Me.Controls("txtStartTime" & i).Value) Then
monthly(i).starttime = CDate(Me.Controls("txtStartTime" & i).Value)
Else

End If

Answer 3

milk1218さんのユーザーフォームスタイルとは違いますが画像添付します



決して、高度なプログラムの書き方ではありません。
なので、貴方様の質問に対する回答も出来ません
それでも良ければ参考までに、後日ソースコード添付します

Comments

[milk1218]

ありがとうございます！
画像まで添付していただき恐れ入ります…。

Answer 4

間違い箇所がありましたので変更おねがいします
Sub Sistクリック（）のところ画像添付します

赤線で囲ったところです　追加・変更

申し訳ございません

Answer 5

先にコードの画像４枚添付します
後からコード送信します。これは、あくまでもド素人のコードですので
参考程度でおねがいします