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

Liên hệ QC
Lần chỉnh sửa cuối:
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
 
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_2.xlsm
    63.3 KB · Đọc: 29
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
 
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:
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 ạ
 
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
 
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

  • gpe.xlsm
    31.8 KB · Đọc: 11
Lần chỉnh sửa cuối:
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:
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

  • gpe (1).xlsm
    32.2 KB · Đọc: 13
@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
 
Web KT
Back
Top Bottom