Tự động điều chỉnh độ cao của dòng (2 người xem)

[hhoang_56]

Vâng Cám ơn Anh, Em xem qua thì thấy
1. Đoạn code dài thì được đưa vào module của cả file
2. Đoạn code ngắn thì đưa vào sheet nào muốn điều chỉnh độ cao của dòng
Đúng k ạ!

Chính xác

 

[♫ђöล♥ßล†♥†µ♫]

Vâng Cám ơn Anh, Em xem qua thì thấy
1. Đoạn code dài thì được đưa vào module của cả file
2. Đoạn code ngắn thì đưa vào sheet nào muốn điều chỉnh độ cao của dòng
Đúng k ạ!

Cái này người ta gọi là học từ trên ngọn học xuống gốc nè

 

[dangky47h]

Cái này người ta gọi là học từ trên ngọn học xuống gốc nè

E mới hi nên mong các Anh chị chỉ bảo và giúp đỡ hi

Bài đã được tự động gộp: 8/7/18

Chính xác

Hi E cám ơn

 

[vova2209]

E mới hi nên mong các Anh chị chỉ bảo và giúp đỡ hi

Bài đã được tự động gộp: 8/7/18

Hi E cám ơn

Anh toàn sài cái này! em thử xem có sướng không?

'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub

Sub CoDanRowBB()
    MergeCellFit Sheets("BBan").Range("E14") '<< dòng cần fix
End Sub

 

[dangky47h]

Anh toàn sài cái này! em thử xem có sướng không?

'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub

Sub CoDanRowBB()
    MergeCellFit Sheets("BBan").Range("E14") '<< dòng cần fix
End Sub

Cám ơn Anh, báo lỗi A ơi

 

[hhoang_56]

Cám ơn Anh, báo lỗi A ơi

Trời ạ. File của bạn có sheet BBan không ???

 

[dangky47h]

Trời ạ. File của bạn có sheet BBan không ???

hi K, E sử dụng 1 fiel đơn thuần Anh ạ!

 

[be_09]

hi K, E sử dụng 1 fiel đơn thuần Anh ạ!

Cần làm sheet nào thì nêu rõ và đưa File lên đây.

 

[vova2209]

Cám ơn Anh, báo lỗi A ơi

@@!
Sub CoDanRowBB()
MergeCellFit Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]).Range([BGCOLOR=rgb(226, 80, 65)]"E14"[/BGCOLOR]) '<< dòng cần fix
End Sub

Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]) đổi thành Sheets("DANH MUC HSNT")
Còn Range("E14") là dòng cần tự động dãn, thay đổi dòng nào mà bạn cần
vd:
Sub CoDanRowBB()
MergeCellFit Sheets("DANH MUC HSNT").Range("B10")
MergeCellFit Sheets("DANH MUC HSNT").Range("B12")
MergeCellFit Sheets("DANH MUC HSNT").Range("B14")
End Sub

 

[♫ђöล♥ßล†♥†µ♫]

@@!
Sub CoDanRowBB()
MergeCellFit Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]).Range([BGCOLOR=rgb(226, 80, 65)]"E14"[/BGCOLOR]) '<< dòng cần fix
End Sub

Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]) đổi thành Sheets("DANH MUC HSNT")
Còn Range("E14") là dòng cần tự động dãn, thay đổi dòng nào mà bạn cần
vd:
Sub CoDanRowBB()
MergeCellFit Sheets("DANH MUC HSNT").Range("B10")
MergeCellFit Sheets("DANH MUC HSNT").Range("B12")
MergeCellFit Sheets("DANH MUC HSNT").Range("B14")
End Sub

Anh ơi em bỏ luôn cái phần đầu thế là hết lỗi ạ

Sub CoDanRowBB()
    MergeCellFit Range("E14") '<< dòng cần fix
End Sub

 

[vova2209]

Anh ơi em bỏ luôn cái phần đầu thế là hết lỗi ạ

Sub CoDanRowBB()
    MergeCellFit Range("E14") '<< dòng cần fix
End Sub

hê hê! hôm nay mưa gió chị yêu nhỉ

 

[HieuCD]

Anh ơi em bỏ luôn cái phần đầu thế là hết lỗi ạ

Sub CoDanRowBB()
    MergeCellFit Range("E14") '<< dòng cần fix
End Sub

Có khi nào "lộn tiệm" không, kiểu râu sheet1 cấm càm sheet2 ấy ấy

 

[vc_đi chơi]

Tôi gữi file lên luôn đây! Trong file hảy nhập text vào các cell màu vàng... (Nói chung là cell nào đã dc merge)
File này vẫn còn lỗi, nhờ các cao thủ sửa giúp (ví dụ xóa dử liệu trong cell sẽ lỗi)
ANH TUẤN

Code này khi thêm nội dung vào thì tự giãn để vừa chiều cao dòng nhưng khi xóa đi hình như chiều cao dòng không bị giảm xuống để căn vừa nội dung (chỉ có tăng lên mà không giảm chiều cao dòng xuống được)

 

[ngochienbmt]

code nay thi file chạy được nhưng mỗi lần change thì toàn bộ file dãn ngang như từ khổ giấy đứng chuyển qua nằm rồi bình thường lại

 

[tuanpccc2009]

Chào cả nhà!
Hiện tại các code trên mình thấy nó đáp ứng được khi thực hiện các thảo tác bằng cách clic chuột. Giờ kết hợp với in tự động thì không thực hiên được. Mong mọi người giúp.

 

[tigertiger]

Chào cả nhà!
Hiện tại các code trên mình thấy nó đáp ứng được khi thực hiện các thảo tác bằng cách clic chuột. Giờ kết hợp với in tự động thì không thực hiên được. Mong mọi người giúp.

Bạn thử phương án, với sub sự kiện event

Private Sub Worksheet_Calculate()

End Sub

sẽ có thể giải quyết được

 

[yulkyun]

Anh/Chị có thể giúp em xem thử sao sheet TB don gia của em không tự động điều chỉnh chiều cao của hàng được ạ? File của em dùng để in hàng loạt nên data trong ô sẽ thay đổi ngắn dài khác nhau. Có thể viết code để tự động điều chỉnh chiều cao tương ứng với mỗi data không ạ?