Các bác cho mình hỏi, mình có code VBA sau nhưng khi kết xuất từ excel sang word nó không tự save as như đường dẫn trong code, các bác chỉ giáo giúp
Với lại mình muốn nó tự đạt tên theo số liệu của 1 ô cố định nào đó trong sheet thì làm ntn?
Thanks các bác
Mã:
Sub Export_to_Word()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
On Error Resume Next
Sheet7.Range("B1:G57").Copy
Set wdapp = GetObject(, "word.Application")
If Err.Number = 429 Then
Err.Clear
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
wdapp.Active
Set wddoc = wdapp.Documents.Add
wddoc.Active
wddoc.Range.PasteSpecial xlPasteValues
Set wddoc = Nothing
Set wdapp = Nothing
wddoc.SaveAs (Application.ThisWorkbook.Path & "\abc.docx")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Const extension_doc = ".docx"
Dim new_name as string
new_name = Sheet7.Range("A1").value2 & extension_doc 'Giả sử tên theo ô A1
'...
wddoc.SaveAs (Application.ThisWorkbook.Path & "\" & new_name
Set wddoc = Nothing
Set wdapp = Nothing
Const extension_doc = ".docx"
Dim new_name as string
new_name = Sheet7.Range("A1").value2 & extension_doc 'Giả sử tên theo ô A1
'...
wddoc.SaveAs (Application.ThisWorkbook.Path & "\" & new_name
Set wddoc = Nothing
Set wdapp = Nothing
Bạn tự mày mò chút chứ ăn sẵn mãi có tiến bộ được đâu. Code của bạn ban đầu sai ở chỗ đã Set wddoc = Nothing rồi thì làm sao nó hoạt động được nữa mà chạy Save as?
Bạn tự mày mò chút chứ ăn sẵn mãi có tiến bộ được đâu. Code của bạn ban đầu sai ở chỗ đã Set wddoc = Nothing rồi thì làm sao nó hoạt động được nữa mà chạy Save as?
Thì bạn cứ học đi! Dùng VBA mà không tùy biến được code, chẳng mỗi lần thay đổi cấu trúc dữ liệu đầu vào 1 chút hoặc thay đổi yêu cầu đầu ra 1 tí lại phải đi hỏi?
Bạn tự mày mò chút chứ ăn sẵn mãi có tiến bộ được đâu. Code của bạn ban đầu sai ở chỗ đã Set wddoc = Nothing rồi thì làm sao nó hoạt động được nữa mà chạy Save as?
Thank bạn, từ đầu thì bạn @befaint đã cho mình biết lỗi
Set wddoc = Nothing '-> Xóa nó rồi còn đâu nữa mà dùng
Set wdapp = Nothing
wddoc.SaveAs (Application.ThisWorkbook.Path & "\abc.docx")
mình đã chỉnh sửa công thức lại, nó chạy không báo lỗi nhưng không tự đặt tên theo đk 1 ô cố định trong sheet
còn bác @songmai lập lại lời của @befaint để làm gì không biết, vô đây cũng để cùng nhau học tập thôi chứ đâu? Mình không biết thì hỏi, bạn nào biết thì chỉ, mình cám ơn vậy thôi
Thanks các bác
Thank bạn, từ đầu thì bạn @befaint đã cho mình biết lỗi
Set wddoc = Nothing '-> Xóa nó rồi còn đâu nữa mà dùng
Set wdapp = Nothing
wddoc.SaveAs (Application.ThisWorkbook.Path & "\abc.docx")
mình đã chỉnh sửa công thức lại, nó chạy không báo lỗi nhưng không tự đặt tên theo đk 1 ô cố định trong sheet
còn bác @songmai lập lại lời của @befaint để làm gì không biết, vô đây cũng để cùng nhau học tập thôi chứ đâu? Mình không biết thì hỏi, bạn nào biết thì chỉ, mình cám ơn vậy thôi
Cảm ơn các bác
Sub Export_to_Word()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
Const extension_doc = ".docx"
Dim new_name As String
new_name = Sheet7.Range("A1") & extension_doc 'Sua lai dia chi cell neu muon
On Error Resume Next
Sheet7.Range("B1:G57").Copy
Set wdapp = GetObject(, "word.Application")
If Err.Number = 429 Then
Err.Clear
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
Set wddoc = wdapp.Documents.Add
wddoc.Activate 'Cho nay ban dau la wddoc.Active -> khong chay duoc nhung bi dong On Error Resume Next can thiep nen cho qua
wddoc.Range.PasteSpecial xlPasteValues
wddoc.SaveAs (Application.ThisWorkbook.Path & "\" & new_name)
Set wddoc = Nothing
Set wdapp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Sub Export_to_Word()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
Const extension_doc = ".docx"
Dim new_name As String
new_name = Sheet1.Range("AJ5") & extension_doc 'Sua lai dia chi cell neu muon
On Error Resume Next
Sheet1.Range("A1:AE54").Copy
Set wdapp = GetObject(, "word.Application")
If Err.Number = 429 Then
Err.Clear
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
Set wddoc = wdapp.Documents.Add
wddoc.Activate 'Cho nay ban dau la wddoc.Active -> khong chay duoc nhung bi dong On Error Resume Next can thiep nen cho qua
wddoc.Range.PasteSpecial xlPasteValues
wddoc.SaveAs Application.ThisWorkbook.Path & "\" & new_name
Set wddoc = Nothing
Set wdapp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
File bạn có 2 thủ tục cùng tên Export_to_Word ở 2 vị trí khác nhau. Bạn xóa thủ tục ở sheet1 đi, để lại Export_to_Word ở Module1. Lý do không chắc là ở đó nhưng cứ thử vì máy tôi chạy bình thường dù xóa hay không
Ở GPE từ "hợp lý" gần như không bao giờ được hiểu theo tính cách khách quan.
Hồi nào giờ bạn có hề thấy thớt nào mà không có câu "trường hợp của em nó đặc thù..." hôn?
Với số lượng hằng trăm ngàn bài trên GPE, tôi đánh cuộc với bạn, chỉ cần đưa ra được đến 3 bài mà chủ thớt chịu nghe theo lời khuyên "hợp lý" thì tôi sẽ thua bạn một chầu phở tái.
Set wdapp = CreateObject("Word.Application")
Set wddocx = wdapp.Documents.Add
Set wddoc = wdapp.Documents.Add
With wddocx
.Range.PasteSpecial xlPasteValues .SaveAs docx_name báo lỗi bác @befaint ạ
.Close
End With
With wddoc
.Range.PasteSpecial xlPasteValues
.SaveAs doc_name
.Close
End With
'clean up
Set wddocx = Nothing: Set wddoc = Nothing
Set wdapp = Nothing
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!", vbInformation
End Sub
Sub Export_to_Word()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
Const extension_doc = ".docx"
Dim new_name As String
new_name = Sheet1.Range("AJ5") & extension_doc 'Sua lai dia chi cell neu muon
On Error Resume Next
Sheet1.Range("A1:AE54").Copy
Set wdapp = GetObject(, "word.Application")
If Err.Number = 429 Then
Err.Clear
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
Set wddoc = wdapp.Documents.Add
wddoc.Activate 'Cho nay ban dau la wddoc.Active -> khong chay duoc nhung bi dong On Error Resume Next can thiep nen cho qua
wddoc.Range.PasteSpecial xlPasteValues
wddoc.SaveAs Application.ThisWorkbook.Path & "\" & new_name
Set wddoc = Nothing
Set wdapp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
