[VBA]工作報告

2013-01-09

1924
0
VBA

[VBA]工作報告

之前都用word打一打就交了，散落在各個檔案中，要整理歷史資料有點難度；試作VBA版本如下：

程式架構

ThisWorkbook



Public Sub FitWorkListContent(ByVal sheetname As String)
    Worksheets(sheetname).Columns("A:D").AutoFit
End Sub



Public Sub SetTitle(ByVal sheetname As String)
    Worksheets(sheetname).Range("A1").Value = "填報日期"
    Worksheets(sheetname).Range("B1").Value = "業務別"
    Worksheets(sheetname).Range("C1").Value = "工作內容"
    Worksheets(sheetname).Range("D1").Value = "完成日期"
End Sub


Public Sub ResetFilter()
    Dim rowCount As Integer, i As Integer
    rowCount = Worksheets("歷史區").Range("B65536").End(xlUp).Row
    For i = 1 To 4
        Worksheets("歷史區").Range("$B$1:$B$" & rowCount).AutoFilter Field:=i, Criteria1:="<>"
        Worksheets("歷史區").Range("$B$1:$B$" & rowCount).AutoFilter Field:=i
    Next
End Sub

工作表1(工作報告)


Private Sub cmd_ClearContet_Click()
    ActiveSheet.Range("A1").Select
    ActiveCell.CurrentRegion.Select
    Selection.ClearContents
    
    Call ThisWorkbook.SetTitle("工作報告")
    Call ThisWorkbook.FitWorkListContent("工作報告")
    
    MsgBox "清除工作報告內容完成!"
End Sub

Private Sub cmd_ClearHistory_Click()
    Dim myRange As Range
    Dim rowCount As Integer
    Application.ScreenUpdating = False
    
    Call ThisWorkbook.ResetFilter
    rowCount = Worksheets("歷史區").[A65536].End(xlUp).Row
    Set myRange = Worksheets("歷史區").Range("A1:D" & rowCount)
    myRange.ClearContents
    
    Call ThisWorkbook.SetTitle("歷史區")
    Call ThisWorkbook.ResetFilter
    MsgBox "清除歷史區內容完成!"
    
    Application.ScreenUpdating = True
End Sub

Private Sub cmd_MoveHistoryWorkList_Click()
    Application.ScreenUpdating = False
    Dim listCount As Integer
    listCount = Worksheets("工作報告").Range("A65536").End(xlUp).Row
    
    If listCount = 1 Then
        MsgBox "沒有工作報告資料可以移至歷史區!"
        Exit Sub
    End If
    
    Worksheets("工作報告").Range("A2:D" & listCount).Copy Worksheets("歷史區").[A65536].End(xlUp).Offset(1, 0)
    MsgBox "移致歷史區完成!"
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
    Call ThisWorkbook.FitWorkListContent("工作報告")
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call ThisWorkbook.FitWorkListContent("工作報告")
End Sub

工作表3(歷史區)



Private Sub Worksheet_Activate()
    Call ThisWorkbook.FitWorkListContent("歷史區")
    Call ThisWorkbook.ResetFilter
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call ThisWorkbook.FitWorkListContent("歷史區")
End Sub

執行畫面

先點選頁籤[業務別]維護經辦的業務

在頁籤[工作報告]可以填寫目前工作報告

在下次填報將目前工作報告資料移到歷史區

清除工作報告內容後可以重新填寫

歷史區的資料可以進行過濾篩選

參考資料

VBA如何篩選非空白單元格

如何把有內容的儲存格copy到另一個工作表最後的空格中？

回首頁