• Trang chủ click to expand contents 

  • Lỗi khi tạo Sheet bằng VBA

  • Lỗi khi tạo Sheet bằng VBA

    Minh Tiên > 23-10-20, 10:15 AM

    Kính nhờ ACE Pro giúp đỡ:
    Tiên có 1 đoạn code tạo Sheet Excel từ Access như sau:
    Mã:
        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

    Khi chạy code trên tạo Sheet đầu tiên và Sheet thứ 2 thì OK nhưng đến Sheet thứ 3 thì bị báo lỗi: Run-time Error "1004": That name is already take. Try a different one. (Mỗi lần chạy đổi 1 tên sheet khác - Cứ còn 1 sheet thì tạo thêm được, còn đã có 2 sheet thì báo lỗi như trên). Khi xuất hiện lỗi thì File bị khóa và chỉ mở được ở chế độ Read Only.
    Nhờ ACE Pro nghiên cứu giúp khắc phục lỗi trên.
    Cảm ơn nhiều !

  • RE: Lỗi khi tạo Sheet bằng VBA

    Minh Tiên > 23-10-20, 12:44 PM

    Mình đã tìm đc lỗi rồi. Lợi dụng sở thích đặt tên sheet của bác Mai. Mình cứ tìm tên này mà rename.
    Thân.

  • RE: Lỗi khi tạo Sheet bằng VBA

    Minh Tiên > 29-10-20, 11:31 AM

    Bài toán hôm trước mình đã gỡ được, nhưng do bận nên chưa share code (Củ chuối của mình 014 ) để các bạn gặp tình huống này tạm khắc phục.
    Hôm nay mình share. Mong nhận được ý kiến đóng góp của ACE để đoạn code hoàn thiện hơn.
    Mã:
    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

    Thân./.