| |
チョット時間が無いので
取り合えずこんな物でお茶を濁します
月報の日にち、日報の時間の行が固定されているので
日にち、時間はMatchiやFinedで探さず、行位置を計算させています
月報フォーマット、実行ファイルどちらでやっても出来ると思いますが
一応、実行ファイルの方でやって見ました
実行ファイルのSheet1に、
コントロールツールボックスのComboBox1とCommandButton1を張りつけます
ThisWorkbookのコードモジュールに以下を記述して下さい
Private Sub Workbook_Open()
Dim i As Long
With Worksheets("Sheet1").ComboBox1
For i = 0 To 23
.AddItem i
Next i
End With
End Sub
Sheet1のコードモジュールに以下を記述して下さい
Private Sub CommandButton1_Click()
With Me.ComboBox1
If .ListIndex <> -1 Then
DataCopy .Value
End If
End With
End Sub
標準モジュールに以下を記述して下さい
Option Explicit
Public Sub DataCopy(ByVal lngTime As Long)
Const strBookName As String = "月報ﾌｫｰﾏｯﾄ.xls"
Const strResult As String = "月報"
Dim i As Long
Dim blnExists As Boolean
Dim wkbData As Workbook
Dim wksResult As Worksheet
Dim lngRow As Long
With Workbooks
For i = 1 To .Count
If .Item(i).Name = strBookName Then
blnExists = True
Exit For
End If
Next i
End With
If Not blnExists Then
Beep
MsgBox "月報ﾌｫｰﾏｯﾄ.xlsがOpenされていません"
Exit Sub
End If
Set wkbData = Workbooks(strBookName)
Set wksResult = wkbData.Worksheets(strResult)
lngTime = lngTime + 4
With wkbData.Worksheets
.Item(strResult).Cells(lngRow, "B").Resize(31, 17).ClearContents
For i = 1 To .Count
If .Item(i).Name <> strResult Then
lngRow = Val(Right(.Item(i).Name, 2)) + 9 - 1
.Item(i).Cells(lngTime, "B").Resize(, 17).Copy _
Destination:=.Item(strResult).Cells(lngRow, "B")
End If
Next i
End With
Set wksResult = Nothing
Set wkbData = Nothing
Beep
MsgBox "処理が完了しました"
End Sub
実行ファイルSheet1のComboBoxで0〜23の数字を選び
CommandButtonを押すと、月報フォーマットの月報に各日付に選択時間の行が
Copyされるはずです
ヤッツケで作っているので、間違っていたらゴメン
其の時は、レスして下さい
|
|
Hirofumi
- 04/6/1(火) 22:43 -
