Cần giúp đỡ về phần dãn dòng khi Merge dòng! (2 người xem)

[vova2209]

Có vài bài nói về tự động điều chỉnh dòng nhưng không đúng như ý em muốn thực hiện nên nhờ các bác giúp đỡ:
khi "Wrap Text" ở 1 ô khi chữ dài ra sẽ tự dãn dòng, ít thì sẽ co lại vừa dòng. Nhưng khi Merge nhiều ô thì "Wrap Text" lại không không tự động co dãn dòng. Nhờ các bác viết cho 1 code tự động chạy co dãn dòng khi vùng link vlookup đó thay đổi, chiều rộng khi co dòng tối thiểu là 18..
File đính kèm dưới:
Em xin chân thành cảm ơn!

 

[PacificPR]

Mình Copy sang file mới thôi. Bạn lập lại file khác đi ( Chắc file cũ lỗi gì đó). File của mình gần 40 Sheet mà cũng không chậm đến vậy

 

[vova2209]

Mình Copy sang file mới thôi. Bạn lập lại file khác đi ( Chắc file cũ lỗi gì đó). File của mình gần 40 Sheet mà cũng không chậm đến vậy

Chết dở file của em cũng gần 40 sheet file toàn link hết giờ mà lập lại cũng chết dở! vâng để em thử lại

 

[PacificPR]

Làm lại cho nó hoành tráng. Đối với file kiểu như hồ sơ QLCL tốt nhất là dùng VBA để cho file nó nhẹ đị cùng lắm mới sử dụng công thức thôi
Làm thêm cái Ribbon

nữa cho đẹp

 

[vova2209]

Làm lại cho nó hoành tráng. Đối với file kiểu như hồ sơ QLCL tốt nhất là dùng VBA để cho file nó nhẹ đị cùng lắm mới sử dụng công thức thôi

Vâng! của em vẫn nhiều công thức update dần bỏ hết công thức đi, file của em 2,5 mb nặng quá! mà có đúng 30 sheet

 

[PacificPR]

Vâng! của em vẫn nhiều công thức update dần bỏ hết công thức đi, file của em 2,5 mb nặng quá! mà có đúng 30 sheet

Bạn thiết kế cái Ribbon như file này cho nó đẹp

 

[vova2209]

Để em up file tổng của em lên anh saver as lại thử xem có được không anh nhé!

 

[vova2209]

Bạn thiết kế cái Ribbon như file này cho nó đẹp

anh saver as hộ như file kia xem được không anh!

 

[PacificPR]

anh saver as hộ như file kia xem được không anh!

Để mai mình thử xem

 

[vova2209]

Để mai mình thử xem

Vâng anh hộ em! cứ mở cùng file này là file của a cũng bị chậm theo ko rõ nguyên nhân là sao

 

[vova2209]

Để mai mình thử xem

Đã tìm ra lỗi tại sao code chạy chậm thế, trong file của em có 3 nguyên nhân dẫn tới code chậm
Chú ý:
1. Không được để chế độ "Page Break Preview" sẽ ảnh hưởng tới tốc độ code "fixRow"
3. Không soi trang trước khi dùng code
2. Không được vlookup ảnh
------------------------------------------------
Code xuất ra PDF có cải thiện được tốc độ không anh nhỉ, em thấy chậm quá!

 

[vova2209]

Mình Copy sang file mới thôi. Bạn lập lại file khác đi ( Chắc file cũ lỗi gì đó). File của mình gần 40 Sheet mà cũng không chậm đến vậy

anh ơi! em cải thiện thêm được tốc độ fix rồi ^^!

Sub RunFixRow()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False

FixRow Sheets("BBan").Range("D14") 'NT Noi Bo
FixRow Sheets("BBan").Range("F45:F49")

FixRow Sheets("BBan").Range("E76") 'Phieu Yeu Cau

FixRow Sheets("BBan").Range("D105") 'NT CVXD
FixRow Sheets("BBan").Range("F139:F143")

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub


Sub FixRow(ByVal Rng As Range)
Dim Ws As Worksheet
Dim row As Range, cell As Range, MrgeWdth As Single
Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
On Error Resume Next

Diff = 0.75
Set Ws = Rng.Worksheet
ColPaste = Ws.UsedRange.Columns.Count + 1
For Each row In Rng
If row <> Empty Then
Set ma = row.MergeArea
For Each cell In ma
MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
Next cell
ma.RowHeight = 16.5
RowPaste = ma.row
Set CellPaste = Cells(RowPaste, ColPaste)
WithCellPaste = CellPaste.ColumnWidth
CellPaste.ColumnWidth = MrgeWdth
CellPaste = ma.Value
CellPaste.Font.Size = ma.Font.Size
If ma.Font.Bold = True Then CellPaste.Font.Bold = True
If ma.Font.Italic = True Then CellPaste.Font.Italic = True
If ma.Font.Underline = xlUnderlineStyleSingle Then CellPaste.Font.Underline = xlUnderlineStyleSingle
CellPaste.WrapText = True
CellPaste.EntireRow.AutoFit
ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
CellPaste.Clear
CellPaste.ColumnWidth = WithCellPaste
End If
Next row
End Sub

 

[langtuchungtinh360]

Bạn thiết kế cái Ribbon như file này cho nó đẹp

bạn có cách nào tạo Ribbon hay không chỉ mình với.
chắc bạn cũng là dân làm xây dựng, vậy có thể Add friend facebook ( Văn Tân Lê, SĐT 0939795092) để bàn cách trình bày file làm hồ sơ quản lý không? hiện mình cũng đang phát triển mà lười quá. cạn kiệt ý tưởng rồi

 

[PacificPR]

bạn có cách nào tạo Ribbon hay không chỉ mình với.
chắc bạn cũng là dân làm xây dựng, vậy có thể Add friend facebook để bàn cách trình bày file làm hồ sơ quản lý không? hiện mình cũng đang phát triển mà lười quá. cạn kiệt ý tưởng rồi

Ô cái đó em lấy của anh về dùng mà hì hì... . Em chuyển từ Sharava36 sang cái này đó. Anh làm xong file BB chưa

 

[langtuchungtinh360]

Ô cái đó em lấy của anh về dùng mà hì hì... . Em chuyển từ Sharava36 sang cái này đó. Anh làm xong file BB chưa

thế à. vẫn chưa xong, đang làm code chỉnh trang biên bản lại. cái code fixhightrow cũng trong số đó. còn code đang viết thì đang định hướng chỉnh lại bảng số liệu (ví dụ cốt thép) thì đôi khi những ô bị mercel lại nằm ngay chỗ giao giữa 2 trang nên cần kéo lề lên. tương tự chữ ký của biên bản.

 

[PacificPR]

thế à. vẫn chưa xong, đang làm code chỉnh trang biên bản lại. cái code fixhightrow cũng trong số đó. còn code đang viết thì đang định hướng chỉnh lại bảng số liệu (ví dụ cốt thép) thì đôi khi những ô bị mercel lại nằm ngay chỗ giao giữa 2 trang nên cần kéo lề lên. tương tự chữ ký của biên bản.

Em thấy phần HSQLCL bên Giá xây dựng họ có phần ngắt trang anh qua đó xem thử xem. Mà kết bạn với anh thì vào đâu. Em không thấy mục này

 

[langtuchungtinh360]

Em thấy phần HSQLCL bên Giá xây dựng họ có phần ngắt trang anh qua đó xem thử xem. Mà kết bạn với anh thì vào đâu. Em không thấy mục này

họ giấu code hết rồi bạn, tham khảo được thì nói gì. facebook bạn là gì? nói trên face dễ hơn, thế nhé. lạc đề topic rồi.

 

[PacificPR]

họ giấu code hết rồi bạn, tham khảo được thì nói gì. facebook bạn là gì? nói trên face dễ hơn, thế nhé. lạc đề topic rồi.

Hôm trước em tải về mở máy cho bẻ khóa 1 ngày không xong. Thế là thất bại chả xem được gì. Em không chơi facebook.
Thôi trả Toptic lại cho chủ của nó thôi.

 

[vova2209]

Bác PacificPR!
Anh ơi! sửa hộ lại em ít code với, fixrow không tự co lại dòng khi không có giữ liệu!
File đính kèm dưới

 

[PacificPR]

Bác PacificPR!
Anh ơi! sửa hộ lại em ít code với, fixrow không tự co lại dòng khi không có giữ liệu!
File đính kèm dưới

Sub FixRow(ByVal Rng As Range)
    Dim Ws As Worksheet
    Dim row As Range, cell As Range, MrgeWdth As Single
    Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
    On Error Resume Next
    Diff = 0.75
    Set Ws = Rng.Worksheet
    ColPaste = Ws.UsedRange.Columns.Count + 1
    For Each row In Rng
        Set ma = row.MergeArea
        For Each cell In ma
            MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
        Next cell
        ma.RowHeight = 16.5
        RowPaste = ma.row
        Set CellPaste = Cells(RowPaste, ColPaste)
        WithCellPaste = CellPaste.ColumnWidth
        CellPaste.ColumnWidth = MrgeWdth
        CellPaste = ma.Value
        CellPaste.Font.Size = ma.Font.Size
        If ma.Font.Bold = True Then CellPaste.Font.Bold = True
        If ma.Font.Italic = True Then CellPaste.Font.Italic = True
        If ma.Font.Underline = xlUnderlineStyleSingle Then CellPaste.Font.Underline = xlUnderlineStyleSingle
        CellPaste.WrapText = True
        CellPaste.EntireRow.AutoFit
        ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
        CellPaste.Clear
        CellPaste.ColumnWidth = WithCellPaste
    Next row
End Sub

 

[lenolim]

Bạn thiết kế cái Ribbon như file này cho nó đẹp

Tôi ấn tượng với file của bạn quá. Cảm ơn bạn đã chia sẻ.
Cho tôi hỏi 1 số vấn đề là:
1. file này bạn làm trên office bao nhiêu nhỉ. Tôi dùng office 2010. Lúc mở ra nó báo lỗi. Tuy nhiên vẫn mở ra và xem được
2. Đây có phải là bản chưa đầy đủ hay sao mà khi KÍCH vào 1 số tiện ích như mục: Xuất biên bản ra Pdf, Ghi nhật ký thi công, Xuất nhật ký ra Pdf. Lúc đó lại hiện thông báo: Chua co code cho muc nay
Mong nhận được sự giúp đỡ. Xin chân thành cảm ơn !