Giúp đỡ căn chỉnh dòng tự động khi soạn văn bản bằng Excel

trungthanhvuutt

Thành viên mới
Tham gia ngày
27 Tháng năm 2020
Bài viết
3
Được thích
0
Điểm
13
Tuổi
25
Lần chỉnh sửa cuối:

thoai

Thành viên thường trực
Tham gia ngày
5 Tháng tám 2006
Bài viết
225
Được thích
25
Điểm
685
em xin file bác sửa cod trên file excel của em ạ
Bài đã được tự động gộp:


cho e xin file excel này của bác tham khảo với ạ
Sub ExportExcel2Word_AllF()

Dim DataC As Long, Tg
Dim dem As Long, EndR As Long, EndC As Long
Dim objRange, objTable
Dim wDoc, aWord
Dim FCol As Long, LCol As Long, i As Long

Const CFont = "Times New Roman"
Const CSize = "14"
Const CColor_Normal = wdColorDarkGreen
Const CColor_Table = wdColorDarkBlue


Tg = Timer()

Set aWord = CreateObject("Word.Application")

'TAO FILE WORD
Set wDoc = aWord.Documents.Add
aWord.Visible = True

'SHEET NGUON: Dem cot, dem dong
For FCol = 1 To 100
If Cells(65536, FCol).End(xlUp).Row > 10 Then Exit For

Next FCol
EndR = Cells(65536, FCol).End(xlUp).Row + 2

Cells(1, FCol).Select
For dem = 1 To EndR
Cells(dem, FCol).Select
If LCol < Selection.Columns.Count Then LCol = Selection.Columns.Count
Next dem
LCol = LCol + FCol - 1
Cells(1, FCol).Select

'CHEP TU DAU DEN CUOI VB
Application.ScreenUpdating = False

For i = 1 To EndR

'Neu khong chia nhieu cot
If WorksheetFunction.CountA(Range(Cells(i, FCol), Cells(i, LCol))) = 1 Or WorksheetFunction.CountA(Range(Cells(i, FCol), Cells(i, LCol))) = 0 Then

'Cell hien hanh khong co du lieu -> chep nguyen dong hien hanh
If Cells(i, FCol) = "" Then
Range(Cells(i, FCol), Cells(i, LCol)).Copy
Set objRange = wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
objRange.Paste
With objRange
.Font.Name = CFont
.Font.Size = CSize
.Font.Color = CColor_Table
End With
Else
wDoc.Range.InsertAfter Cells(i, FCol) & vbCrLf 'Chep du lieu neu co
End If

'Dinh dang doan van ban
With wDoc.Paragraphs(wDoc.Paragraphs.Count - 1).Range

.Font.Name = CFont
.Font.Size = CSize
.Font.Color = CColor_Normal

'Dinh dang cac dong co font chu Dam
If Cells(i, FCol).Font.Bold = True Then
.Font.Bold = True
End If

'Can chinh
If Cells(i, FCol).HorizontalAlignment = xlCenter Then
.ParagraphFormat.Alignment = wdAlignParagraphCenter
Else
.ParagraphFormat.Alignment = wdAlignParagraphJustify
End If

'Gian cach giua 2 doan van ban
.ParagraphFormat.SpaceBefore = 3
.ParagraphFormat.SpaceBeforeAuto = False
.ParagraphFormat.SpaceAfter = 3
.ParagraphFormat.SpaceAfterAuto = False

End With

'Neu tai cac dong co nhieu cot
Else
If WorksheetFunction.CountA(Range(Cells(i, FCol), Cells(i, LCol))) > 1 Then

If Cells(i, FCol).Borders(xlEdgeTop).LineStyle = xlContinuous Then

For dem = i To EndR
If Cells(dem, FCol).Borders(xlEdgeRight).LineStyle = xlNone Then Exit For
Next dem
Range(Cells(i, FCol), Cells(dem - 1, LCol)).Copy
'Cells(dem - 1, FCol).Select
i = dem - 1
Else
Range(Cells(i, FCol), Cells(i, LCol)).Copy
End If

'Chep Table tu Excel sang Word
Set objRange = wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
'On Error Resume Next

objRange.Paste
With objRange
.Font.Name = CFont
.Font.Size = CSize
.Font.Color = CColor_Table
End With
'On Error GoTo 0

End If
End If

Next i

'Dinh dang le trang in
With wDoc.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2.2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(3.3)
.RightMargin = CentimetersToPoints(1.5)
End With

Dim oTbl As Object, oTblX As Object
Set oTblX = wDoc.Tables(1)
oTblX.AutoFitBehavior (wdAutoFitContent)


Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox "Tong thoi gian la " & Round(Timer() - Tg, 2) & " giay"

'Call LuuFileWord
aWord.Activate 'Xem ket qua

Set wDoc = Nothing
Set aWord = Nothing

End Sub
 

songmai

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2007
Bài viết
92
Được thích
36
Điểm
670
Tôi chỉnh sửa nhiều chỗ trong Autofit chiều cao dòng và xuất ra Word. Trong đó, xuất ra Word có 3 Sub. Các bạn tải file BC của bạn tuan16 về chạy thử với các lưu ý:
1. Autofit: cần chuẩn bị cột phụ như trong file và khai báo cột phụ ở gần đầu sub, chỗ: ChrCol = "R" 'Khai báo cot phu de AutoFit. Cột R đó tôi để đó cho trực quan, nhưng khi dùng trong thực tế phải ẩn đi.
2. ExportExcel2Word: Khai báo cell chứa giá trị header và footer chỗ Hder = Range("S1"): Fter = Range("S2") gần cuối sub. Ở các sub không format văn bản thì khi xuất sẽ phụ thuộc vào định dạng Style Normal của Word. Bạn cần setting áp dụng cho tất cả các document của Word trước khi chạy sub.
 

File đính kèm

tuan16

Thành viên hoạt động
Tham gia ngày
28 Tháng mười một 2013
Bài viết
104
Được thích
2
Điểm
370
Tuổi
30
Tôi chỉnh sửa nhiều chỗ trong Autofit chiều cao dòng và xuất ra Word. Trong đó, xuất ra Word có 3 Sub. Các bạn tải file BC của bạn tuan16 về chạy thử với các lưu ý:
1. Autofit: cần chuẩn bị cột phụ như trong file và khai báo cột phụ ở gần đầu sub, chỗ: ChrCol = "R" 'Khai báo cot phu de AutoFit. Cột R đó tôi để đó cho trực quan, nhưng khi dùng trong thực tế phải ẩn đi.
2. ExportExcel2Word: Khai báo cell chứa giá trị header và footer chỗ Hder = Range("S1"): Fter = Range("S2") gần cuối sub. Ở các sub không format văn bản thì khi xuất sẽ phụ thuộc vào định dạng Style Normal của Word. Bạn cần setting áp dụng cho tất cả các document của Word trước khi chạy sub.
Cảm ơn bác nhiều. Đoạn code chạy ổn trên file bác gửi lên... Nhưng em không hiểu sao khi em lấy đoạn code ra và áp dụng trên một file excell mới thì luôn báo lỗi. Chắc em còn sai ở bước nào rồi
 

thoai

Thành viên thường trực
Tham gia ngày
5 Tháng tám 2006
Bài viết
225
Được thích
25
Điểm
685
Cảm ơn bác nhiều. Đoạn code chạy ổn trên file bác gửi lên... Nhưng em không hiểu sao khi em lấy đoạn code ra và áp dụng trên một file excell mới thì luôn báo lỗi. Chắc em còn sai ở bước nào rồi
Excel bị lỗi thiếu thư viện
Bài đã được tự động gộp:

Tôi chỉnh sửa nhiều chỗ trong Autofit chiều cao dòng và xuất ra Word. Trong đó, xuất ra Word có 3 Sub. Các bạn tải file BC của bạn tuan16 về chạy thử với các lưu ý:
1. Autofit: cần chuẩn bị cột phụ như trong file và khai báo cột phụ ở gần đầu sub, chỗ: ChrCol = "R" 'Khai báo cot phu de AutoFit. Cột R đó tôi để đó cho trực quan, nhưng khi dùng trong thực tế phải ẩn đi.
2. ExportExcel2Word: Khai báo cell chứa giá trị header và footer chỗ Hder = Range("S1"): Fter = Range("S2") gần cuối sub. Ở các sub không format văn bản thì khi xuất sẽ phụ thuộc vào định dạng Style Normal của Word. Bạn cần setting áp dụng cho tất cả các document của Word trước khi chạy sub.
Bac songmai xem dùm lỗi: Đối với các hình ảnh trong excel khi xuất qua word thì vẫn còn tình trạng lúc có lúc không có hình
 
Lần chỉnh sửa cuối:

tuan16

Thành viên hoạt động
Tham gia ngày
28 Tháng mười một 2013
Bài viết
104
Được thích
2
Điểm
370
Tuổi
30
Excel bị lỗi thiếu thư viện
Bài đã được tự động gộp:


BSongmaimai xem dùm lỗi: Đối với các hình ảnh trong excel khi xuất qua word thì vẫn còn tình trạng lúc có lúc không có hình
Khác phục lỗi thư viện này sao bác. Hướng dẫn em với ạ
 

songmai

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2007
Bài viết
92
Được thích
36
Điểm
670
Cảm ơn bác nhiều. Đoạn code chạy ổn trên file bác gửi lên... Nhưng em không hiểu sao khi em lấy đoạn code ra và áp dụng trên một file excell mới thì luôn báo lỗi. Chắc em còn sai ở bước nào rồi
Bạn không thể nhờ người khác giúp với cách như vậy. Tôi nhớ rằng đã nhắc bạn rồi nên giờ tôi không nhắc nữa.
Bài đã được tự động gộp:

Excel bị lỗi thiếu thư viện
Bài đã được tự động gộp:


Bac songmai xem dùm lỗi: Đối với các hình ảnh trong excel khi xuất qua word thì vẫn còn tình trạng lúc có lúc không có hình
Tôi chưa làm việc với hình nên không thể trả lời bạn được
 

tuan16

Thành viên hoạt động
Tham gia ngày
28 Tháng mười một 2013
Bài viết
104
Được thích
2
Điểm
370
Tuổi
30
cài lại office hoặc gửi file lên đây
bác xem giúp mình với ạ
Bài đã được tự động gộp:

Bạn không thể nhờ người khác giúp với cách như vậy. Tôi nhớ rằng đã nhắc bạn rồi nên giờ tôi không nhắc nữa.
Bài đã được tự động gộp:


Tôi chưa làm việc với hình nên không thể trả lời bạn được
dạ thưa bác. đoạn code autofit của bác thì em chạy bình thường. nhưng những đoạn code để xuất ra word lại không được nên em mới phải nên hỏi các bác ạ
 

File đính kèm

Lần chỉnh sửa cuối:

thoai

Thành viên thường trực
Tham gia ngày
5 Tháng tám 2006
Bài viết
225
Được thích
25
Điểm
685
cài lại office hoặc gửi file lên đây
Bac songmai xem dùm lỗi: Đối với các hình ảnh trong excel khi xuất qua word thì vẫn còn tình trạng lúc có lúc không có hình
Bài đã được tự động gộp:

bác xem giúp mình với ạ
Bài đã được tự động gộp:


dạ thưa bác. đoạn code autofit của bác thì em chạy bình thường. nhưng những đoạn code để xuất ra word lại không được nên em mới phải nên hỏi các bác ạ
bỏ 3 dòng này
Const CColor_Normal = wdColorblack
Const CColor_Table = wdColorblack
Bài đã được tự động gộp:

 
Lần chỉnh sửa cuối:

tuan16

Thành viên hoạt động
Tham gia ngày
28 Tháng mười một 2013
Bài viết
104
Được thích
2
Điểm
370
Tuổi
30
Bac songmai xem dùm lỗi: Đối với các hình ảnh trong excel khi xuất qua word thì vẫn còn tình trạng lúc có lúc không có hình
Bài đã được tự động gộp:


bỏ 3 dòng này
Const CColor_Normal = wdColorblack
Const CColor_Table = wdColorblack
Bài đã được tự động gộp:
đã bỏ
dòng này
Const CColor_Normal = wdColorblack
Const CColor_Table = wdColorblack
ở cả 3 sub mà không được bác ạ. Nhờ bác xem với ạ
 

File đính kèm

songmai

Thành viên chính thức
Tham gia ngày
6 Tháng tám 2007
Bài viết
92
Được thích
36
Điểm
670
@thoai
Bạn cần xuất table sang Word kiểu gì?
1- Xuất 1 bảng có địa chỉ cụ thể trong file Excel vào 1 nơi cụ thể chuẩn bị sẵn trong file Word.
2- Xuất tất cả các bảng có trong file Excel vào cùng 1 nơi cụ thể chuẩn bị sẵn trong file Word.

... (ý của bạn)

Nếu có file mẫu thì dễ code
 
Top Bottom