Tạo file excel mới Create new workbook

tuhocvba

Administrator
Thành viên BQT
Chủ đề ngày hôm nay, chúng ta bàn về việc tạo ra file workbook mới.
Ứng dụng của nó: Một là tạo ra file output theo yêu cầu. Điều này khỏi phải bàn. Và một ứng dụng ta hay gặp nhất đó chính là tạo file điều tra (tiếng nhật là アンケート) như đã từng bàn .
1. Tạo file mới từ sheet.
Ví dụ người dùng nhận được file điều tra (アンケート), sau khi ấn nút Send, thực chất là code sẽ save as sheet của bản điều tra đó, cất vào một đường dẫn được chỉ định. Đây là phương pháp hiện nay đang áp dụng ở nhiều công ty nhằm tránh xung đột nếu chỉ sử dụng một file điều tra mà có tới cả ngàn con người cùng truy cập một file thì thật nguy hiểm.
Mã:
Sub taofilemoitusheet()
    Dim wb As String
    Dim lk As String
    lk = "C:\Users\jpnfriend.net\Desktop\VBA\a8.xls"
    Application.ScreenUpdating = False 'Khong cap nhat man hinh, tang toc do xu ly
    Application.DisplayAlerts = False 'Khong hien canh bao trong qua trinh xu ly
    ThisWorkbook.Sheets(1).Copy
    wb = ActiveWorkbook.Name
    Workbooks(wb).SaveAs lk
    Workbooks(Dir(lk)).Close 'Dir(lk) sẽ trả về file name
  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Đây là cách được sử dụng rất nhiều.
2. Tạo file mới hoàn toàn.
Đây là cách ít được sử dụng là vì mất thời gian code tỉa tót từng chút một cho file bằng code. Từ độ rộng cột, tô màu hàng nào, vị trí tiêu đề ra sao... Thông thường người thiết kế cố gắng tạo ra một mẫu (gọi là template) cho người dùng điền thông tin và sau khi click lệnh thì mẫu đó xuất ra file mới theo cách 1 ở trên.
Tuy nhiên việc tạo file mới hoàn toàn không phải là không có. Vì vậy chúng ta sẽ bàn về vấn đề này.
Những vấn đề chúng ta gặp phải gồm có:
Tên file. Đây là vấn đề quan trọng, nếu chúng ta cố định tên file là tuhocvba.xls, và file được tạo ra cất trong một folder được chỉ định. Như thế chúng ta sẽ phải tốn công tốn sức kiểm tra xem file tuhocvba.xls đã tồn tại trong folder đó hay chưa, file có tên như vậy có đang được mở hay không?... Nếu gặp phải một trong những vấn đề trên, thì file sẽ không thể được tạo ra. Do đó, để đảm bảo tính duy nhất của file, người ta thường cho kèm thông tin ngày giờ phút giây vào tên file.
Ví dụ:
Mã:
Sub test()
    MsgBox Format(Now, "yymmddhhmmss")
End Sub
Ta sẽ có kết quả: Năm 2019, tháng 07, ngày 07, 12h30p59s
Bạn cần đăng nhập để thấy hình ảnh


Vấn đề tiếp theo chúng ta hay gặp là số lượng sheet trong một file. Đôi khi chúng ta tạo ra workbook mới và nhận thấy trên đó có sẵn 3 sheet. Tổng quát, chúng ta muốn kiểm soát, khi có một workbook mới được tạo ra thì trên đó có sẵn bao nhiêu sheet.
Chúng ta có code sau:
Mã:
Application.SheetsInNewWorkbook = 1
Cuối cùng hãy xem chương trình mẫu dưới đây:
Mã:
Sub taofilemoihoantoan()
Dim s As String
Dim wbnew As String
'Ten workbook
s = "C:\Users\jpnfriend.net\Desktop\VBA\tuhocvba" & Format(Now, "yymmddhhmmss") & ".xls"
Application.ScreenUpdating = False 'Khong cap nhat man hinh, tang toc do xu ly
Application.DisplayAlerts = False 'Khong hien canh bao trong qua trinh xu ly

'Tao wokbook moi co so luong sheet theo chi dinh
Application.SheetsInNewWorkbook = 1
Workbooks.Add
wbnew = ActiveWorkbook.Name
Workbooks(wbnew).Sheets(1).Cells(1, 1).Value = "tuhocvba.net"
Workbooks(wbnew).SaveAs s 'luu file vao duong dan duoc chi dinh
Workbooks(Dir(s)).Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Trên đây tôi đã tổng hợp lại các cách thức thường gặp. Tất nhiên ta còn có những tình huống khác, hẹn gặp lại các bạn ở các bài viết khác.
 

vbano1

SMod
Thành viên BQT
Có khi nào tạo mới xong mà lại muốn delete file không nhỉ.
Giới thiệu thêm đoạn code xóa file cho đủ bộ.
Step 1:
Kiểm tra file định xóa có tồn tại hay không?
Step 2:
Thực hiện xóa
(Thực ra cẩn thận hơn thì nên check xem file có được mở hay không nữa, vì nếu đang mở thì không thể xóa được)
Mã:
Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function
Sub DeleteFile(ByVal FileToDelete As String)
   If FileExists(FileToDelete) Then 'See above          
      ' First remove readonly attribute, if set
      SetAttr FileToDelete, vbNormal          
      ' Then delete the file
      Kill FileToDelete
   End If
End Sub
 

MinhKhoi1206

Thành viên mới
Tìm mãi mới thấy cái em đang cần em chưa biết gì về VBA chỉ đi copy nên ko hiểu làm ntn với code này có thể chỉnh sửa từ 1 sheet xuất ra được file exel ra màn hình có 2 sheet theo định dạng mình muốn được không ạ?
 

tuhocvba

Administrator
Thành viên BQT
Trong bài viết #1 phần code ví dụ đã viết rồi, bạn chỉnh sửa lại là:
Mã:
'Tao wokbook moi co so luong sheet theo chi dinh
Application.SheetsInNewWorkbook = 2
Khi đó file được tạo ra sẽ có 2 sheet. Việc tô màu kẻ vẽ như thế nào đối với các sheet thì bạn tùy ý làm thôi.
 

MinhKhoi1206

Thành viên mới
Trong bài viết #1 phần code ví dụ đã viết rồi, bạn chỉnh sửa lại là:
Mã:
'Tao wokbook moi co so luong sheet theo chi dinh
Application.SheetsInNewWorkbook = 2
Khi đó file được tạo ra sẽ có 2 sheet. Việc tô màu kẻ vẽ như thế nào đối với các sheet thì bạn tùy ý làm thôi.
Mã:
Sub export_1()
Dim ws As Worksheet
Dim wb As Workbook
Dim fr, lr As Long
Dim str, path1 As String

Set wb = ThisWorkbook
path1 = wb.Path
Set ws = Sheet2

Application.ScreenUpdating = False

str = ws.Name & ".xlsx"

lr = ws.Cells(Rows.Count, "B").End(xlUp).Row

Workbooks.Add.SaveAs Filename:=path1 & "\" & str
Set wb2 = Workbooks(str)

wb.Activate
ws.Range("W3:BR" & lr).Copy
wb2.Sheets(1).[a1].PasteSpecial xlPasteValues
wb2.Sheets(1).[a1].PasteSpecial xlPasteFormats
wb2.Sheets(1).[a1].PasteSpecial xlPasteColumnWidths
wb2.Sheets(1).Cells.Font.Size = 10
wb2.Close SaveChanges:=True

Application.CutCopyMode = False
MsgBox str
Application.ScreenUpdating = True

End Sub
Mình đang dùng đoạn code như vậy để xuất ra file cùng nơi lưu file và đặt lại tên nhưng bây giờ muốn sửa lại để có thể xuất ra file có 2 sheet theo mẫu và lấy dữ liệu từ sheet đã xử lý vào các cột tương ứng mà chưa biết sửa thế nào b có thể chỉ giúp m được ko
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Dòng code số 16-17 của bạn sửa thành:
Mã:
Application.SheetsInNewWorkbook = 2
Workbooks.Add.SaveAs Filename:=path1 & "\" & str
Ngoài ra, đây là Box học thuật, để tránh làm loãng topic học thuật, nếu có câu hỏi nào, bạn nên post bài trong Box Thành Viên Tự Giúp Nhau.
 

MinhKhoi1206

Thành viên mới
Dòng code số 16-17 của bạn sửa thành:
Mã:
Application.SheetsInNewWorkbook = 2
Workbooks.Add.SaveAs Filename:=path1 & "\" & str
Ngoài ra, đây là Box học thuật, để tránh làm loãng topic học thuật, nếu có câu hỏi nào, bạn nên post bài trong Box Thành Viên Tự Giúp Nhau.
Cảm ơn ạn nhiều để m up sang box nhờ mọi người tư vấn
 
Top