Chào tất cả anh em, tôi phải soạn một số văn bản có những thông tin cố định và thay đổi, tôi muốn lập một sheet khai báo đầy đủ thông tin và các văn bản bên trong sẽ tự động bắt link thông tin ấy tùy theo ý muốn. Tuy nhiên mỗi lần thay thông tin phải tự căn chỉnh lại các dòng nội dung thay đổi rất tốn thời gian. Vậy tôi nhờ ae trợ giúp bằng cách KICK vào " căn chỉnh dòng tự động" là các dòng tự giãn vừa đủ để in cho đẹp. Cảm ơn ae giúp đỡ.
Giúp đỡ căn chỉnh dòng tự động khi soạn văn bản bằng Excel (1 người xem)
- Thread starter thuangsxd
- Ngày gửi
Người dùng đang xem chủ đề này
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
Góp ý cho bạn:
1/ Bạn muốn thực hiện trên sheet nào thì nên nêu rõ tên sheet muốn tự động co giản dòng.
2/ Bạn nên tô màu nền những chỗ muốn tự động co giản dòng, chứ đừng để người giúp phải đi tìm.
3/ Nếu có nhiều dự án thì ở Sheet Khai báo thông tin nên nhập liệu tất cả nội dung của 1 dự án trên 1 dòng. để chọn mã dự án thì nó tự động lấy tất cả các nội dung vào. Trong File của bạn dùng Link nên sẽ rất khó khăn khi thay đổi tên dự án.
Cảm ơn bạn đã góp ý, mình xin gửi lại file đính kèm, ý mình muốn sửa ở các Sheet phía sau gồm: Hợp đồng, Đề nghị thanh toán; giám sát ở các dòng đã bôi màu.
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
Sheet Khai báo thông tin tôi có nêu "Nếu có nhiều dự án thì ở nên nhập liệu tất cả nội dung của mỗi dự án chỉ trên 1 dòng" thì mới tự động hóa được (nhập liệu theo kiểu bạn là thua), vậy thì bạn nên nhập liệu ít nhất là 2 dự án để người giúp có cái mà thử.
Tên dự án, công trình, công ty, địa chỉ mình để chế độ vào kick chọn như file kèm theo nv có được k? hay vẫn phải nhập riêng lẻ?
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bạn thử file nhé. Giải thích sơ lược:
- Tạm dùng các cell của cột L (đã ẩn) để lấy dữ liệu của hợp đồng từ cột A đến cột K.
- Cột L dùng để chạy code autofit row vì nếu dùng cell đã bị merged (từ A đến K) thì code không tác dụng.
- Các row có chữ chỉ gọn trong 1 dòng thì tại cột L bạn nên xóa công thức của dòng tương ứng để code chạy nhanh hơn, còn không thì chờ 1 tí cũng không sao
- Vùng dữ liệu hợp đồng đã căn chỉnh horizontal là justify để in ra cho đẹp
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
1/ Cách làm của bạn dùng Link từng Cell từ sheet Khai báo sang là chưa hợp lý, nên lấy dữ liệu từ sheet Thong tin con sang để in hàng loạt nhiều công trình (vì 1 dự án có thể có nhiều công trình), sheet này chủ Topic bổ sung khi tôi có góp ý ở bài 2 nhưng chưa đúng ý (chia ra 3 bảng) theo ý tôi là gộp chung vô 1 bảng.
2/ Bạn dùng cột phụ cũng là một sáng kiến hay, trong excel không có chức năng co giản dòng các Cell gộp ô ( Merge and Center) nếu sử dụng code thì vẫn làm được mà không cần đến cột phụ.
3/ Khi áp dụng Justify thì nên áp dụng cho tất cả các Cell có chứa nhiều dòng thì mới đẹp, chứ không nên áp dụng chỉ riêng những Cell cần lấy dữ liệu.
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Muốn căn chỉnh dòng nào thì bạn cứ dùng công thức tại các cell cột J là bằng cell tương ứng ở cột A (đã merge). Code lần lượt chạy từ cell cuối cột J đến J1
Cảm ơn bạn, mình đã làm được, tuy nhiên khi xuất ra in bị hiện tượng khoảng cách giữa các dòng không đều nhau, in ra không đẹp lắm, bạn giúp thêm mình nhé. Cảm ơn bạn nhiều.
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Xuất PDF vừa lâu vừa xấu. Mình có code xuất sang Word nhưng dùng cho mẫu của bạn lại chưa hoàn chỉnh lắm. Để mình xem chỉnh sửa lại rồi gửi cho
cảm ơn bạn nhiều. Mình chờ kết tin tốt từ bạn
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bạn tải file này về rồi chép code sang file của bạn. Khi chạy nếu báo lỗi thì là do chưa chọn thư viện MS Word nên không tương tác với Word được. Gặp lỗi này, tại cửa sổ code, vào Tools/References thấy MISSING Microsoft Word gì đó thì bỏ chọn và kéo xuống kiếm chọn vào Microsoft Word phiên bản gì gì đó cũng được.
Code tôi viết cũng chẳng hay ho gì, chạy cũng không nhanh lắm vì khả năng có hạn và nhất là làm việc với Word bằng VBA Excel cũng khoai lắm, nhưng dù sao cũng ngon lành hơn xuất trực tiếp ra PDF từ Excel
Chúc vui!
dạ. chào anh chị. a xem giúp em với ạ. em copy đoạn code của anh vào file mà không chạy được ạ
Dạ em làm theo mà không được.. Bác giúp em sửa file trên với ạ
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bạn suy nghĩ đi. Cấu trúc VB của chủ topic với của bạn trên Excel khác nhau chỗ nào. Ở trên, dù chưa xem file của bạn tôi đã nhắc. Tuy nhiên tôi cũng nói rồi, việc này cũng xương lắm, không chắc đúng với mọi văn bản. Đây là file tôi làm lại theo file bạn gửi. Sheet copy là để test nhanh
Lần chỉnh sửa cuối:
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Tôi gửi lại file, có chỉnh sửa vài chỗ trong code
code bị lỗi khi xuất sheet (Đề nghị thanh toán) thì các table không xuất đc
File đính kèm
Lần chỉnh sửa cuối:
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bạn chạy file tôi gửi hay chép vào file bạn để chạy? file tôi không lỗi, dưới đây là đính kèm kết quả. LƯU Ý cấu trúc chỗ Số thứ tự
Đúng là code này chạy trên file thì được chứ chép code sang file khác sẽ không chạy được
File bạn gửi. Tiện cho hỏi muốn xuất cả footer thì sao bạn
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Không biết bạn à, vì nhu cầu tôi chưa tới đó. Thường thì khi tôi cần làm gì thì tôi mới đi tìm hiểu. Search tiếng Việt không có thì bằng tiếng Anh, thế nào rồi cũng có. Tuy nhiên dùng VBA Excel làm việc với Word mệt lắm vì không rành.
Bài đã được tự động gộp:
Tôi tùy biến thì chạy được, tất nhiên đó là khi đó thực sự là nhu cầu của riêng tôi vì chỉ thay đổi riêng tí chút là dùng cho những người khác lại không được.
P/S: File bạn định dạng hay làm thứ gì mà nặng thế. Khi tôi mở nó lên thì Excel ì ạch kinh khủng không làm được gì khác. Mà tôi cũng không dám Enable macro cho nó, thấy ghê ghê.
Lần chỉnh sửa cuối:
Bác dạy em cách tùy biến được không ạ.em làm các văn bản trên excell lên khi gửi cho người khác thì chỉ gửi file word
để ý cái số cột như ... EndC = 9 ... Bạn thay số cột cần in là dc
Đoạn này phải không bác Range("A1").Select
EndC = 12 . khi dòng bắt đầu của em là C2 em sửa mà không được bác ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
Co giản dòng trong Excel đã khó, xuất ra Word lại càng khó hơn và cũng không chuẩn như thực hiện trên File Word (chỉ tương đối thôi).
endR là dòng , EndC là cột nhé, nếu bắt đầu có dữ liệu từ dòng 2 thì bạn phải sửa là Range("A2").select
Dạ bác. bác xem đoạn code trong file này có tùy biến để mình sử dụng được trên file khác không ạ
có thể xuất header và footer theo các ô chỉ định (A1 và A2) từ excel qua word luôn dc không Chú Be09
dạ. ý em là sao mình cứ copy đoạn code ra 1 file mới hoàn toàn thì bị lỗi ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
Thì tôi lấy File đó làm thử xuất ra File Word này nè, nhưng code co giản dòng tôi làm chưa chuẩn nên không đưa File lên.
Bài đã được tự động gộp:
Chờ chú hoàn thiện xong code co giản dòng trong Excel và xuất ra File Word hoàn chỉnh rồi mới tính đến cái vụ Header và Footer.
Phải làm từng bước chứ ba cái vụ này khó quá nên không thể làm một lần là xong ngay.
Lần chỉnh sửa cuối:
file word bác có chỉnh sửa sau khi xuất ra từ excell không ạ. Bác cho em xin file bác vữa làm với ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
File đó là dùng code xuất ra, nhưng code canh Paragraph chưa chuẩn tôi còn đang sửa, khi nào xong tôi đưa File lên 1 lần.
Bác xem giúp em. Sao đoạn code trên em code ra và làm trên file khác thì luôn báo lỗi ạ. Ví dụ như file này ạ
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Tôi sửa lại code rồi. Bạn đem về chạy thử xem. Văn bản của bạn ở cột nào cũng được
Rich (BB code):
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 = 6
.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)
For Each oTbl In wDoc.Tables
oTbl.Rows.LeftIndent = oTbl.Rows.LeftIndent - PicasToPoints(1.45)
Next oTbl
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 Subem copy đoạn code của bác vào chạy vẫn báo lỗi ạ.
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Báo thế nào bạn? Bạn muốn giúp thì đừng kiệm lời, nói cho rõ tình trạng vào! Cần thiết thì chụp màn hình post lên.
Dạ đây bác ạ... Em cứ copy đoạn code sang hẳn một file mới là báo lỗi
File đính kèm
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Chỗ đó khi tôi chạy thỉnh thoảng bị lỗi. Bạn thêm câu lệnh On Error Resume Next trước đoạn định dạng lề trang in đó, và câu On Error Goto 0 ngay sau đoạn đó. Tác dụng là nếu nó định dạng được thì tốt, không thì phải tự làm bằng tay vậy.
Tôi cũng chẳng biết vì sao lỗi, nhưng thường xảy ra khi tôi đóng 1 file Word kết quả chạy thử để chạy tiếp lần nữa.
Không biết có cao nhân nào chỉ giúp tại sao bị lỗi đó không?
Chờ bác be09 bác ạ. Bác ấy xuất ra file nhìn đẹp bác ạ
Bác be09 ơi. Bác sửa đoạn code được chưa ạ. Bác cho em tham khảo để vận dụng vào file của mình với ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,883
- Nghề nghiệp
- Công chức
Mấy hôm nay tôi đi nhậu suốt, có ở nhà đâu mà xem.
Hôm nay tôi cũng sỉn, giờ mới dậy đọc bài.
Dạ. Khi nào bác có thời gian thì xem giúp em với ạ
Bạn Sonmai xem dùm mình đoạn code chỗ này bị lỗi, phiền bạn giải thích dùm
File đính kèm
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Lỗi giao tiếp giữa Excel và Word khi dùng cách khai báo Word.Application muộn. Bạn thử đóng hết các cửa sổ Word và Excel rồi chạy lại lệnh xem có bị lỗi nữa không. Nếu vẫn lỗi bạn bỏ đoạn đó đi, tôi chỉ muốn thử kéo các table của Word sang bên trái 1 tí thôi, không cần thiết lắm.
Phần bôi vàng....indent ... bị lỗi gì!
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Thì tôi đã giải thích rồi đó: Lỗi giao tiếp giữa Excel và Word
Em vẫn chờ bác be09 vào giúp. Em thấy bác ấy có văn bản bác ấy xuất ra word ở trên đẹp rồi .
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Ờ. Nếu bạn ấy làm được code dùng với mọi cấu trúc văn bản thì hay quá. Tôi thì chỉ cố làm theo cấu trúc chung đến đó thôi, còn nếu cần gì nữa thì tùy biến code hoặc gọn nhất là lấy con chuột kéo chỉnh sơ chiều rộng các table của file Word là hoàn chỉnh
Co thể xuất header và footer sang word theo gia1 trị cell A1 và a2 k bạn
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Được chứ. Thêm đoạn code sau vào gần cuối
Mã:
Dim Hder As String, Fter As String
Hder = Range("O1"): Fter = Range("O2") 'Thay cell O1, O2 bằng cel khác tùy ý bạn
With wDoc
With .ActiveWindow
.ActivePane.View.SeekView = wdSeekCurrentPageHeader
.Selection.TypeText Text:=Hder
.ActivePane.View.SeekView = wdSeekCurrentPageFooter
.Selection.TypeText Text:=Fter
End With
.Application.Browser.Next
End With
Lần chỉnh sửa cuối:
trungthanhvuutt
Thành viên mới
- Tham gia
- 27/5/20
- Bài viết
- 3
- Được thích
- 0
Xin cao nhân chỉ giáo
Hiện giờ em có 2 file excel. File 1 là File bác đã chỉnh sửa cod chuyển từ excel sang word em thấy thế là đẹp và hiệu quả rồi tuy nhiên cod căn chỉnh dòng của nó k chuẩn, nên e có file 2 cũng là sưu tầm cod căn chỉnh dòng nhưng chưa có cod chuyển excel sang word như bác, Xin cao nhân giúp đỡ ghép 2 loại cod đấy thành 2 nút điều chỉnh như File 1 giúp em được ạ
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bạn xem lại cái code bạn sưu tầm, bạn chạy thử nó chưa?. Tôi chọn 1 range ví dụ từ A1:J50 thì chạy xong nó merge cả range đó luôn với giá trị là của cell A1 nguồn.
Nói cho bạn biết thêm: tôi cũng cố tìm hiểu các nguồn bằng tiếng Anh, dù trình tiếng Anh của tôi như hạch, thì có 2 phương pháp để AutoFit chiều cao dòng:
- Một là đếm cột, đọc tổng chiều rộng vùng dữ liệu nguồn, hủy merge và cho chiều rộng cột đầu bằng tổng kia. Sau đó Autofit Row rồi trả lại nguyên trạng dữ liệu nguồn (code bạn theo hướng đó nhưng không làm được như tôi mô tả)
- Hai là dùng một cột phụ bên ngoài vùng dữ liệu nguồn, chỉnh chiều rộng cột sao cho chữ trong từng cell khớp với range tương ứng đã merge của dữ liệu nguồn. Sau đó Autofit Row cột phụ này thì dữ liệu nguồn sẽ theo đó mà khớp đúng (tất nhiên sẽ có 1 vài dòng bị giãn hơn bình thường do ngẫu nhiên có vài cell chữ quá khít với chiều rộng cell, vụ này Autofit bằng tay cũng vậy thôi, chỉ có cách dùng chuột kéo theo ý mình. Code hướng thứ nhất cũng sẽ bị như vậy). Tôi thực hiện theo hướng này vì tôi nghĩ là dễ kiểm soát hơn.
Tôi không thể theo hướng 1 được vì tôi còn có việc và cuộc sống của mình, không có thời gian dành cho việc đó.
Em vẫn đang hóng đợi. Đợi xem có bác nào vào giúp
Như thế này còn k đẹp thì như nào đẹp
Em xin file excell của bác với ạ
Bạn chỉ chỉnh căn dòng trong code là dc
Em muốn xin file excell của bác để lấy đoạn code vận dụng vào của em ạ
Lấy code bác so mai sửa lần 2 mà
Sao em code về trên file em không được ạ. Bác cho em xem file để xem cấu trúc trên file của bác với ạ
trungthanhvuutt
Thành viên mới
- Tham gia
- 27/5/20
- Bài viết
- 3
- Được thích
- 0
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 ạ
Lần chỉnh sửa cuố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
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
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.
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
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
Lần chỉnh sửa cuối:
Khác phục lỗi thư viện này sao bác. Hướng dẫn em với ạ
cài lại office hoặc gửi file lên đây
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
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
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 ạ
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:
Lần chỉnh sửa cuối:
đã 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 ạ
songmai
Thành viên chính thức
- Tham gia
- 6/8/07
- Bài viết
- 92
- Được thích
- 37
- Giới tính
- Nam
Bài viết mới nhất
- Question
Kết quả lọc dữ liệu từ sheet TONG HOP qua từng chi tiết
(6 người xem)
Xử lý giúp hàm MAXIFS
(2 người xem)
- Question
Em nhờ các bro giúp giải pháp in nhiều file ạ
(1 người xem)
- Question
