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

[tuan16]

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 ạ

 

[tuan16]

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: 6/6/20

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.

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]

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 ạ

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.

 

[tuan16]

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 ạ

 

[thoai]

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

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 Sub

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

 

[songmai]

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

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.

 

[thoai]

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]

Phần bôi vàng....indent ... bị lỗi gì!

Thì tôi đã giải thích rồi đó: Lỗi giao tiếp giữa Excel và Word

 

[tuan16]

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]

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 .

Ờ. 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

 

[thoai]

Ờ. 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]

Co thể xuất header và footer sang word theo gia1 trị cell A1 và a2 k bạn

Được chứ. Thêm đoạn code sau vào gần cuối

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

 

[thoai]

Được chứ. Thêm đoạn code sau vào gần cuối

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

 

[trungthanhvuutt]

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!

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]

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 ạ

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 đó.

 

[tuan16]

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 ạ

Em vẫn đang hóng đợi. Đợi xem có bác nào vào giúp

 

[thoai]

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

 

[tuan16]

Như thế này còn k đẹp thì như nào đẹp

Em xin file excell của bác với ạ

 

[thoai]

Em xin file excell của bác với ạ

Bạn chỉ chỉnh căn dòng trong code là dc

 

[tuan16]

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 ạ