Đú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
Giúp đỡ căn chỉnh dòng tự động khi soạn văn bản bằng Excel (6 người xem)
- Thread starter thuangsxd
- Ngày gửi
Người dùng đang xem chủ đề này
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
- 36
- 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,882
- 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,882
- 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,882
- 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
- 36
- 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
- 36
- 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
- 36
- 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?
