EXCEL VBAコミュの初歩の初歩で・・・・

仮に１つだったら、そのファイルを使って何をするのでしょうか？
その部分が既にできていれば、そのコードをＵＰしてください。

知的障害者向けの出勤簿をつくります。
コードってこれでいいのでしょうか？すみません･･･

---------------------------------------------------
Sub Auto_Open()

ActiveWindow.WindowState = xlMaximized

Frm_Main.Show '開始します

End Sub


Sub Sub終了処理()

End
-----------------------------------------------------

これは、Frm_Main.Show でユーザーフォームを表示している
だけですよ。
ユーザーフォームを表示して、そこで何をしているのかにつ
いては、このコードだけでは分かりません。

すみません。質問の仕方もおぼつかないので
もっとレベルを上げてまた来ます。
いつのことか分かりませんが･･･
ごめんなさい。お騒がせしました。

おそらく、Frm_Mainというユーザーフォームの中に本体の処理
があると思われます。
まずは、そこを見るとよさげです。

こんな感じなんですが･･･^^;

オブジェクトのデザインを見せられても…　(-_-;)

｢プロジェクトウィンドウ｣内の"Frm_Main"を右クリックして
｢コードの表示｣を選択すれば、コードを見ることができます。

VBEの用語についてはコチラ↓を見てください。
http://www.moug.net/skillup/buef/vy003-1.htm
http://www.moug.net/skillup/buef/vy003-2.htm

ホントでした！
頭が相当おかしくなりつつあります。
これは私が書いたものではありませんので
著作権の問題があるのでしたら削除します。

私に出来るんでしょうか･･･（涙

---------------------------------------------------------

Option Explicit

Dim strFileName As String
Dim BkLog() As Variant 'Logデータ退避用配列
Dim EndLog() As Variant 'END行格納用
Dim GYO As Long '格納するセルの行数


Private Sub UserForm_Activate()

'システム日付をセット
If MultiPage1.Value = 0 Then
Cmb_Dtp.Value = Now
Else
Cmb_Dtp2.Value = Now
End If

End Sub

Private Sub Cmd_End_Click()

Call Sub終了処理

End Sub

Private Sub MultiPage1_Change()

If MultiPage1.Value = 0 Then
Cmb_Dtp.Value = Now
Else
Cmb_Dtp2.Value = Now
End If

End Sub


Private Sub Cmd_Sakusei_Click()
'************************************
'* 出勤簿作成ボタン
'************************************
Dim WkDate As String
Dim I As Integer
Dim xlAPP As Application ' Applicationオブジェクト
Dim objWBK As Workbook ' ワークブックObject
Dim swESC As Boolean ' Escキー判定


'処理確認メッセージ
If FunMsg(Format(Cmb_Dtp.Value, "yyyy/mm/dd") & "の出勤簿を作成します。よろしいですか？", vbQuestion + vbYesNo, "追加確認") = vbNo Then
'処理しない
Exit Sub
End If

WkDate = ""
strFileName = ""
WkDate = Format(Cmb_Dtp.Value, "yymmdd")

'選択した日付のcsvがあるかチェック
strFileName = Dir("C:\ComiPenSample\Log\Log" & WkDate & "*.csv", vbNormal)

If strFileName = "" Then
'Logファイル無し
MsgBox Format(Cmb_Dtp.Value, "yyyy/mm/dd") & "のLogファイルが存在しません。"
Exit Sub
End If

'************************************************************
'選択した日付のLogファイルを１つのファイルにする処理
'************************************************************
GYO = 1

Set xlAPP = Application
With xlAPP
.ScreenUpdating = False ' 画面描画停止
.EnableEvents = False ' イベント動作停止
.EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする
'''''.Cursor = xlWait 'カーソルを砂時計にする
End With
On Error GoTo Button1_Click_ESC

'選択した日付のcsvについて繰り返す
Do While strFileName <> ""
' Escキー打鍵判定
DoEvents
If swESC = True Then
' 中断するのかをメッセージで確認
If MsgBox("中断キーが押されました。ここで終了しますか？", _
vbInformation + vbYesNo) = vbYes Then
GoTo Button1_Click_EXIT
Else
swESC = False
End If
End If

'検索した１ファイル単位の処理
' ステータスバーに処理ファイル名を表示
xlAPP.StatusBar = strFileName & " 処理中．．．．"
' ワークブックを開く(読み取り専用)
Set objWBK = Workbooks.Open( _
FileName:="C:\ComiPenSample\Log\" & strFileName, _
UpdateLinks:=False, ReadOnly:=True)

'Log内容を取得
Call Sub配列格納(strFileName)

' 開いたブックをClose
objWBK.Close SaveChanges:=False

' 次のファイル名を参照
strFileName = Dir '次のcsvファイル名をDir関数で受け取ります
Loop

If GYO <= 2 Then
MsgBox "該当Logファイルが存在しませんでした。" & vbCrLf & "処理を中断しました。"
GoTo Button1_Click_EXIT
End If

'退避しているEND行を配列にセット
ReDim Preserve BkLog(4, GYO)
BkLog(1, GYO) = EndLog(1)
BkLog(2, GYO) = EndLog(2)
BkLog(3, GYO) = EndLog(3)
BkLog(4, GYO) = EndLog(4)

'出勤簿を作成
Call Sub出勤簿

'処理終了
GoTo Button1_Click_EXIT

'----------------
' Escキー脱出用行ラベル
Button1_Click_ESC:
If Err.Number = 18 Then
' EscキーでのエラーRaise
swESC = True
Resume
ElseIf Err.Number = 1004 Then
' 隠しシートや印刷対象なしの実行時エラーは無視
Resume Next
Else
' その他のエラーはメッセージ表示後終了
MsgBox Err.Description
End If

'----------------
' 処理終了
Button1_Click_EXIT:
With xlAPP
.StatusBar = False ' ステータスバーを復帰
.EnableEvents = True ' イベント動作再開
.EnableCancelKey = xlInterrupt ' Escキー動作を戻す
.Cursor = xlDefault ' カーソルをデフォルトにする
.ScreenUpdating = True ' 画面描画再開
End With
Set objWBK = Nothing
Set xlAPP = Nothing

End Sub

Private Sub Sub配列格納(pFile As String)
'************************************************
'* Logファイルの内容を配列に格納
'************************************************
Const cnsTITLE = "テキストファイル読み込み処理"
Dim xlAPP As Application ' Applicationオブジェクト
Dim intFF As Integer ' FreeFile値
Dim OpenFile As String ' OPENするファイル名(フルパス)
Dim lngREC As Long ' レコード件数カウンタ
Dim X(3) As Variant ' 読み込んだレコード内容
Dim strREC As String ' レコード領域
Dim POS1 As Long ' レコード文字位置INDEX
Dim POS2 As Long ' レコード文字位置INDEX
Dim IX1 As Long ' CSV項目カラムINDEX


lngREC = 0

'Applicationオブジェクト取得
Set xlAPP = Application

'「ファイルを開く」のフォームでファイル名の指定を受ける
OpenFile = "C:\ComiPenSample\Log\" & pFile

'FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
'指定ファイルをOPEN(入力モード)
Open OpenFile For Input As #intFF

'ファイルのEOF(End of File)まで繰り返す
Do Until EOF(intFF)
'レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "読み込み中です．．．．(" & lngREC & "レコード目)"

'ファイルを行で読み込み
Line Input #intFF, strREC

'LineInputより自分で半角カンマを探しCSV→項目分割させる
POS1 = 1
IX1 = 0
Do While POS1 <= Len(strREC)
POS2 = InStr(POS1, strREC, ",", vbTextCompare)
If POS2 < POS1 Then
POS2 = Len(strREC) + 1
End If
X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1))
'シングルコーテーション、ダブルコーテーションで囲まれている場合は両端文字を取り除く
If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _
((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then
X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2))
End If
POS1 = POS2 + 1
IX1 = IX1 + 1
Loop

'配列に格納処理
If lngREC = 1 Then
'START行は最初のcsvファイルだけ配列に格納
If GYO = 1 Then

'一応選択日とLogの日付をチェック
If Format(X(0), "yyyy/mm/dd") <> Format(Cmb_Dtp.Value, "yyyy/mm/dd") Then
'処理確認メッセージ
If FunMsg("選択日（" & Format(Cmb_Dtp.Value, "yyyy/mm/dd") & "）とLog（" & Format(X(0), "yyyy/mm/dd") & "）の日付が違います。よろしいですか？", vbQuestion + vbYesNo, "追加確認") = vbNo Then
'処理しない
Close #intFF ' 指定ファイルをCLOSE
xlAPP.StatusBar = False
Exit Sub
End If
End If

'最初だけSTART行を配列に格納
ReDim BkLog(4, 1)
BkLog(1, 1) = X(0)
BkLog(2, 1) = X(1)
BkLog(3, 1) = X(2)
BkLog(4, 1) = X(3)
GYO = GYO + 1
End If

Else
If X(2) = "END" Then
'END行を退避
ReDim EndLog(4)
EndLog(1) = X(0)
EndLog(2) = X(1)
EndLog(3) = X(2)
EndLog(4) = ""

Else
'配列に格納
ReDim Preserve BkLog(4, GYO)
BkLog(1, GYO) = X(0)
BkLog(2, GYO) = X(1)
BkLog(3, GYO) = X(2)
BkLog(4, GYO) = X(3)
GYO = GYO + 1
End If
End If
Loop

'指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False

End Sub

Private Sub Sub出勤簿()
'************************************************
'* 出勤簿を作成
'************************************************
Const cnsTITLE = "出勤簿出力処理"
Dim xlAPP As Application ' Applicationオブジェクト
Dim WkDate As String
Dim WkDd As String


'Applicationオブジェクト取得
Set xlAPP = Application
xlAPP.Cursor = xlWait 'カーソルを砂時計にする

WkDate = Format(Cmb_Dtp.Value, "gee年mm月")
WkDd = Format(Cmb_Dtp.Value, "dd")

'出勤簿があるかチェック
strFileName = Dir("C:\ComiPenSample\" & WkDate & "*.xls", vbNormal)

If strFileName = "" Then
'出勤簿が作成されていない
'新規にブックを作成する
Call Subブック作成(WkDate, WkDd)

Else
'出勤簿がある
'同一シート名があるかチェック
Call SubシートChk(WkDate, WkDd)
End If

'出勤簿を作成
Call Sub出勤簿作成(WkDate, WkDd)

xlAPP.Cursor = xlDefault 'カーソルをデフォルトにする
xlAPP.StatusBar = False

'終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & GYO - 2 & "件", vbInformation, cnsTITLE

End Sub

Private Sub Subブック作成(pYymm As String, pDd As String)
'************************************************
'* ブックを新規に作成
'************************************************
Dim MyWs As Worksheet '自シート


'ブックを新規に作成
Workbooks.Add
ActiveWorkbook.SaveAs FileName:="C:\ComiPenSample\" & pYymm & ".xls"

'シート名を設定日付にし、アクティブシートにする
Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = pDd
ActiveSheet.Name = pDd

'新規作成なのでアクティブシート以外のシートをすべて無条件に削除
With Application
.DisplayAlerts = False
For Each MyWs In Worksheets
If MyWs.Name <> ActiveSheet.Name Then MyWs.Delete
Next
.DisplayAlerts = True
End With

End Sub

Private Sub SubシートChk(pYymm As String, pDd As String)
'************************************************
'* シートがあるかチェック
'************************************************
Dim MyWs As Worksheet '自シート
Dim MyFlag As Boolean 'チェック用フラグ
Dim xlAPP As Application ' Applicationオブジェクト


'ブックを開く
Workbooks.Open FileName:="C:\ComiPenSample\" & pYymm & ".xls"

'シートがあるかチェック
MyFlag = False
For Each MyWs In Worksheets
If MyWs.Name = pDd Then
MyFlag = True
Exit For
End If
Next

If MyFlag = True Then
'シートがあったので削除して新たに作り直す
On Error Resume Next
With Application
.DisplayAlerts = False '---警告メッセージ非表示
Sheets("pDd").Delete
.DisplayAlerts = True '---警告メッセージ表示
End With
End If

'日付順になるようにシートを追加
MyFlag = False
For Each MyWs In Worksheets
If CInt(MyWs.Name) > CInt(pDd) Then
MyFlag = True
Exit For
End If
Next

If MyFlag = False Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = pDd
Else
Worksheets.Add(Before:=Worksheets(MyWs.Name)).Name = pDd
End If

End Sub

Private Sub Sub出勤簿作成(pYymm As String, pDd As String)
'************************************************
'* 出勤簿を作成する
'************************************************
Const cnsTITLE = "出勤簿作成処理"
Dim Cnt As Long
Dim InTime As Long
Dim InName As Long
Dim OutTime As Long
Dim OutName As Long
Dim WkTime As String
Dim BkX As Integer 'キャンセル用
Dim BkY As Integer 'キャンセル用


'見出しの設定
Cells(1, 1).Value = "名前"
Cells(1, 2).Value = "出社時間"
Cells(1, 3).Value = "名前"
Cells(1, 4).Value = "退社時間"

Cnt = 2
InTime = 2
InName = 2
OutTime = 2
OutName = 2
WkTime = "12:00:00"

'最終行（START・ENDは除く）まで繰り返す
Do Until Cnt >= GYO
Select Case BkLog(4, Cnt)
Case "st" '出社
Cells(InTime, 2).Value = BkLog(2, Cnt)
BkX = 2
BkY = InTime
InTime = InTime + 1

Case "end" '退社
Cells(OutTime, 4).Value = BkLog(2, Cnt)
BkX = 4
BkY = OutTime
OutTime = OutTime + 1

Case "can" 'キャンセル
Select Case BkX
Case 1
Cells(BkY, 1).Value = ""
InName = InName - 1

Case 2
Cells(BkY, 2).Value = ""
InTime = InTime - 1

Case 3
Cells(BkY, 3).Value = ""
OutName = OutName - 1

Case Else
Cells(BkY, 4).Value = ""
OutTime = OutTime - 1
End Select

Case Else '名前 + その他
'12時以前は出社、12時以降は退社
If Format(BkLog(2, Cnt), "hhss") < Format(WkTime, "hhss") Then
'出社
Cells(InName, 1).Value = BkLog(4, Cnt)
BkX = 1
BkY = InName
InName = InName + 1

Else
'退社
Cells(OutName, 3).Value = BkLog(4, Cnt)
BkX = 3
BkY = OutName
OutName = OutName + 1
End If
End Select

'行を加算
Cnt = Cnt + 1
Loop

'ブックを閉じる
ActiveWorkbook.Close SaveChanges:=True

End Sub


Private Sub Cmd_Csv_Click()
'************************************
'* ＣＳＶ作成ボタン
'************************************
Dim WkDate As String
Dim I As Integer
Dim xlAPP As Application ' Applicationオブジェクト
Dim objWBK As Workbook ' ワークブックObject
Dim swESC As Boolean ' Escキー判定


'処理確認メッセージ
If FunMsg(Format(Cmb_Dtp2.Value, "yyyy/mm/dd") & "のＣＳＶを作成します。よろしいですか？", vbQuestion + vbYesNo, "追加確認") = vbNo Then
'処理しない
Exit Sub
End If

WkDate = ""
strFileName = ""
WkDate = Format(Cmb_Dtp2.Value, "yymmdd")

'選択した日付のcsvがあるかチェック
strFileName = Dir("C:\ComiPenSample\Log\Log" & WkDate & "*.csv", vbNormal)

If strFileName = "" Then
'Logファイル無し
MsgBox Format(Cmb_Dtp2.Value, "yyyy/mm/dd") & "のLogファイルが存在しません。"
Exit Sub
End If

'************************************************************
'選択した日付のLogファイルを１つのファイルにする処理
'************************************************************
GYO = 1

Set xlAPP = Application
With xlAPP
.ScreenUpdating = False ' 画面描画停止
.EnableEvents = False ' イベント動作停止
.EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする
'''''.Cursor = xlWait ' カーソルを砂時計にする
End With
On Error GoTo Button1_Click_ESC

'選択した日付のcsvについて繰り返す
Do While strFileName <> ""
' Escキー打鍵判定
DoEvents
If swESC = True Then
' 中断するのかをメッセージで確認
If MsgBox("中断キーが押されました。ここで終了しますか？", _
vbInformation + vbYesNo) = vbYes Then
GoTo Button1_Click_EXIT
Else
swESC = False
End If
End If

'検索した１ファイル単位の処理
' ステータスバーに処理ファイル名を表示
xlAPP.StatusBar = strFileName & " 処理中．．．．"
' ワークブックを開く(読み取り専用)
Set objWBK = Workbooks.Open( _
FileName:="C:\ComiPenSample\Log\" & strFileName, _
UpdateLinks:=False, ReadOnly:=True)

'Log内容を取得
Call Sub配列格納(strFileName)

' 開いたブックをClose
objWBK.Close SaveChanges:=False

' 次のファイル名を参照
strFileName = Dir '次のcsvファイル名をDir関数で受け取ります
Loop

If GYO <= 1 Then
MsgBox "該当Logファイルが存在しませんでした。" & vbCrLf & "処理を中断しました。"
GoTo Button1_Click_EXIT
End If

'退避しているEND行を配列にセット
ReDim Preserve BkLog(4, GYO)
BkLog(1, GYO) = EndLog(1)
BkLog(2, GYO) = EndLog(2)
BkLog(3, GYO) = EndLog(3)
BkLog(4, GYO) = EndLog(4)

'まとめたLogのcsvを作成
Call Sub作成(Format(Cmb_Dtp2.Value, "yyyymmdd"))

'処理終了
GoTo Button1_Click_EXIT

'----------------
' Escキー脱出用行ラベル
Button1_Click_ESC:
If Err.Number = 18 Then
' EscキーでのエラーRaise
swESC = True
Resume
ElseIf Err.Number = 1004 Then
' 隠しシートや印刷対象なしの実行時エラーは無視
Resume Next
Else
' その他のエラーはメッセージ表示後終了
MsgBox Err.Description
End If

'----------------
' 処理終了
Button1_Click_EXIT:
With xlAPP
.StatusBar = False ' ステータスバーを復帰
.EnableEvents = True ' イベント動作再開
.EnableCancelKey = xlInterrupt ' Escキー動作を戻す
.Cursor = xlDefault ' カーソルをデフォルトにする
.ScreenUpdating = True ' 画面描画再開
End With
Set objWBK = Nothing
Set xlAPP = Nothing

End Sub

Private Sub Sub作成(pDate As String)
'************************************************
'* まとめたLogのcsvを作成
'************************************************
Const cnsTITLE = "CSVテキストファイル出力処理"
Dim xlAPP As Application ' Applicationオブジェクト
Dim intFF As Integer ' FreeFile値
Dim SvFile As String ' OPENするファイル名(フルパス)
Dim SvGyo As Long ' 収容するセルの行
Dim lngREC As Long ' レコード件数カウンタ
Dim I As Long ' カラム(Work)


'Applicationオブジェクト取得
Set xlAPP = Application

SvFile = "C:\ComiPenSample\Log\" & pDate & ".csv"

'FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
'指定ファイルをOPEN(出力モード)
Open SvFile For Output As #intFF

SvGyo = 1

'最終行まで繰り返す
Do Until SvGyo > GYO
'レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "出力中です．．．．(" & lngREC & "レコード目)"
'レコードを出力
Write #intFF, BkLog(1, SvGyo), BkLog(2, SvGyo), BkLog(3, SvGyo), BkLog(4, SvGyo)
'行を加算
SvGyo = SvGyo + 1
Loop

'指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False

'終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & lngREC & "件", vbInformation, cnsTITLE

End Sub

コミュ参加さして頂きました
よろしくです(´∀｀)

ざっと見てみました。（動かしたのではなく、机上でコードを
追っただけですが。）
CSVを書き出している箇所(Cmd_Csv_Click→Sub作成)も
読み込んでいる箇所(Cmd_Sakusei_Click→Sub配列格納)も
本質的には１つずつしかないようですが、どうしたいのですか？
# "本質的に"と書いたのは、Cmd_Csv_Clickでも読み込みが
# ありますが、これはCSVファイルを作るための準備と思わ
# れるので。

Cmd_Csv_Clickで、既にあるファイルと連結しているようです
が、ココを変えたいということでしょうか？

どのみち、今のコードを理解しないと修正は難しいですよ。
コントロールからの入力でファイル名を決めているので、
そこを理解しないと結局思い通りに動かないようは気がしま
す。

もう一度テストしてみます。
何度も何度もお手数掛けました。
Logをもっとたくさん落としてそれから
再度テストをしてみます。

説明の仕方もおぼつかないのでは
何にもなりませんものね。

お騒がせしてしまい、申し訳ありませんでした。

動きました。お騒がせしました。