Minh Tiên > 23-10-20, 10:15 AM
Dim TenFile As String: TenFile = CurrentProject.Path & "\ThuNghiem.xlsx"
Dim TenSheet As String: TenSheet = "DaTa"
Dim Ex As Object
Dim Wb As Object
Dim Ws As Object
Set Ex = GetObject("", "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set Ex = CreateObject("Excel.Application")
End If
If Dir(TenFile) = "" Then
Set Wb = Ex.Workbooks.Add 'Tao WorkBook moi
Set Ws = Wb.Worksheets("Sheet1")
Ws.Name = TenSheet
Wb.SaveAs FileName:=TenFile
Else
Set Wb = Ex.Workbooks.Open(TenFile) 'Mo WorkBook co san
End If
For Each Sheet In Wb.Worksheets
If Sheet.Name = TenSheet Then
Set Ws = Wb.Worksheets(TenSheet) 'Mo Sheet co san
Exit For
Else
Wb.Worksheets.Add.Name = TenSheet ' Tao Sheet moi voi ten TenSheet
Set Ws = Wb.Worksheets(TenSheet)
End If
Next
Wb.Close SaveChanges:=True
Set Ws = Nothing
Set Wb = Nothing
Set Ex = Nothing
Minh Tiên > 23-10-20, 12:44 PM
Minh Tiên > 29-10-20, 11:31 AM
Function XuatExcel(TenFile As String, TenSheet As String)
Dim Ex As Object
Dim Wb As Object
Dim Ws As Object
Set Ex = GetObject("", "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set Ex = CreateObject("Excel.Application")
End If
If Dir(TenFile) = "" Then
Set Wb = Ex.Workbooks.Add
Wb.SaveAs FileName:=TenFile
Else
Set Wb = Ex.Workbooks.Open(TenFile)
End If
With Wb
If WorkSheetExist(Wb, TenSheet) = False Then
If WorkSheetExist(Wb, "Sheet1") = True Then
Set Ws = Wb.Worksheets("Sheet1")
Ws.Name = TenSheet
Else
Wb.Worksheets.Add
Set Ws = Wb.Worksheets("Sheet1")
Ws.Name = TenSheet
End If
Set Ws = Wb.Worksheets(TenSheet)
Else
Set Ws = Wb.Worksheets(TenSheet)
Wb.Sheets(TenSheet).cells.Delete
End If
End With
With Ws
‘Thuc hien cac thao tac tren Sheet ...
End With
Wb.Close SaveChanges:=True
Set Ws = Nothing
Set Wb = Nothing
Set Ex = Nothing
Function WorkSheetExist(Wb As Object, TenSheet As String) As Boolean
For Each Sheet In Wb.Worksheets
If Sheet.Name = TenSheet Then
WorkSheetExist = True
Exit For
End If
Next
End Function