Code sao cho chiều cao mỗi dòng tự động x1,1( so với chiều cao Autofit) (1 người xem)

[LinDan]

Mặc dù em không sử dụng chế độ Merge Cell, tuy nhiên đối với các ô có nhiều chữ khi sử dụng chế độ Auto fit (nháy đúp chuột) khi in ra vẫn có hiện tượng không nhìn thấy chữ.

Trường hợp này em muốn chiều cao dòng tăng lên 1,1 lần chẳng hạn (so với chế độ Auto fit) thì viết làm thế nào ah?

 

[thanhlanh]

Thử vậy đi, hên xui:

Sub StRows()   
    Dim i As Long
    Dim k As Long
    With ActiveSheet.UsedRange
        .Rows.AutoFit
        For i = 1 To .Rows.Count
            k = Rows(i).RowHeight
            Rows(i).RowHeight = 1.1 * k
        Next
    End With
End Sub

 

[LinDan]

Thử vậy đi, hên xui:

Sub StRows()   
    Dim i As Long
    Dim k As Long
    With ActiveSheet.UsedRange
        .Rows.AutoFit
        For i = 1 To .Rows.Count
            k = Rows(i).RowHeight
            Rows(i).RowHeight = 1.1 * k
        Next
    End With
End Sub

Cảm ơn bác, cho em nhờ bác chút nếu bây giờ em muốn Code trên chỉ có tác dụng với vùng bảng mà em lựa chọn thì sửa thế nào? Ví dụ em chọn từ vùng A6:B150 thì nó chỉ điều chỉnh dòng cho các vùng này (không ảnh hưởng đến các vùng dữ liệu khác trên màn hình)
---
Vùng chọn nào em muốn áp dụng do em tự lựa chọn bằng chuột (hoặc bàn phím) thủ công.

 

[thanhlanh]

Cảm ơn bác, cho em nhờ bác chút nếu bây giờ em muốn Code trên chỉ có tác dụng với vùng bảng mà em lựa chọn thì sửa thế nào? Ví dụ em chọn từ vùng A6:B150 thì nó chỉ điều chỉnh dòng cho các vùng này (không ảnh hưởng đến các vùng dữ liệu khác trên màn hình)
---
Vùng chọn nào em muốn áp dụng do em tự lựa chọn bằng chuột (hoặc bàn phím) thủ công.

Bạn đổi code này thử:

Sub StRows2()    
    Dim i As Long, k As Long, rVung As Range
    On Error Resume Next
    Set rVung = Application.InputBox(Prompt:="Dung chuot chon vung can dieu chinh", Type:=8)
    If rVung Is Nothing Then Exit Sub
    On Error GoTo 0
    With rVung
        .Rows.AutoFit
        For i = 1 To .Rows.Count
            k = Range(rVung(i, 1).Address).RowHeight
            Range(rVung(i, 1).Address).EntireRow.RowHeight = 1.1 * k
        Next
        .Select
    End With
End Sub

 

[LinDan]

Bạn đổi code này thử:

Sub StRows2()    
    Dim i As Long, k As Long, rVung As Range
    On Error Resume Next
    Set rVung = Application.InputBox(Prompt:="Dung chuot chon vung can dieu chinh", Type:=8)
    If rVung Is Nothing Then Exit Sub
    On Error GoTo 0
    With rVung
        .Rows.AutoFit
        For i = 1 To .Rows.Count
            k = Range(rVung(i, 1).Address).RowHeight
            Range(rVung(i, 1).Address).EntireRow.RowHeight = 1.1 * k
        Next
        .Select
    End With
End Sub

Cái này khi Merge Cell thì phải làm thế nào cho chạy tốt hả bác? Em đang rất cần, phiền bác chỉ dùm với

 

[ndu96081631]

Cái này khi Merge Cell thì phải làm thế nào cho chạy tốt hả bác? Em đang rất cần, phiền bác chỉ dùm với

Với merge cell thì không dễ nhai đâu nha. Nguyên tắc chung:
- Bỏ merge cell
- AutoFit
- Xong, merge cell trở lại
(Thuật toán chỉ vậy chứ bắt tay vào làm cũng không phải chuyện dễ)

 

[LinDan]

Với merge cell thì không dễ nhai đâu nha. Nguyên tắc chung:
- Bỏ merge cell
- AutoFit
- Xong, merge cell trở lại
(Thuật toán chỉ vậy chứ bắt tay vào làm cũng không phải chuyện dễ)

Quả thật tầm em không giải quyết được bài này, kính nhờ thày giúp em với.