Gửi bởi
emconnhaxd
Bạn ơi file kia làm được mình làm lại y hệt file đó mà lại bị lỗi. Nhân tiện nếu mình làm ở các vị trí C7, C9, C11 chẳng hạn thì lệnh sẽ như thế nào
y hệt thì y hệt. bạn không copy code MergeCellFit vô lấy gì có mà nó chạy được
bạn sửa code tại sheet 2 lại thế này
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
With Sheet2
dong = .UsedRange.Rows.Count
End With
For i = 1 To dong
If Cells(i, 1).MergeCells = True Then MergeCellFit Cells(i, 1)
Next
End Sub
thêm code này vào Module 1
Mã:
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
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
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
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
không thì xem file này, khỏi đánh số hợp đồng làm chi làm chậm hết mấy thao tác.
tải file về xem nha bạn, cạch cạch chuột vô nút kế số HĐ thôi là chạy