Wrap text

[ducdinh1987]

Chào anh chị, anh chị cho em hỏi về Wrap text tí.

Ví dụ.
Tại ô A1 = giá trị ô B7.

khi B7 có len = 10 thì tự động Wrap text ô A1

Khi B7 có len = 50 thì tự động Wrap text ô A1.

Có cách nào tự động nó Wrap text mà không cần mình chỉnh thủ công hay không?

Em cảm ơn!

 

[HeSanbi]

Có một cách duy nhất là dùng VBA thôi bạn.

Tham khảo code dưới đây:
Copy đoạn code dưới đây vào một Module trong VBE (Alt+F11)
(* VBA phải được Xác nhận độ tin cậy trong mục File/Options/Trust Center/Trust Center Setting... )
Thực hiện:

A1 = WrapAuto(B7, True)
Đối số TRUE/FALSE sẽ không hoặc Wrap cả ô B7
A1 = WrapAuto(B7) mặc định là FALSE

*Nhớ sửa lại tiêu đề để phù hợp ("Tự động WrapText khi giá trị một ô được gán thay đổi")
---------------

Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private WrapAutoCellCaller  As Range, WrapAutoCellValue  As Range, WTACC_TimerID&
Private Sub WraptextAutoCallback()
  On Error Resume Next
  KillTimer 0&, WTACC_TimerID: WTACC_TimerID = 0
  Application.ScreenUpdating = False
  WrapAutoCellCaller.WrapText = False
  WrapAutoCellCaller.WrapText = True
  If Not WrapAutoCellValue Is Nothing Then
    WrapAutoCellValue.WrapText = False
    WrapAutoCellValue.WrapText = True
    Set WrapAutoCellValue = Nothing
  End If
  Application.ScreenUpdating = True
  Set WrapAutoCellCaller = Nothing
End Sub
Function WrapAuto(ByVal CellValue As Range, Optional WrapCellValue As Boolean = False) As Variant
  WrapAuto = CellValue(1, 1).Value2
  Set WrapAutoCellCaller = Application.Caller
  If WrapCellValue Then Set WrapAutoCellValue = CellValue(1, 1)
  If CellValue(1, 1).HasFormula Then Application.Volatile
  If WTACC_TimerID <> 0 Then KillTimer 0&, WTACC_TimerID
  WTACC_TimerID = SetTimer(0&, 0&, 1, AddressOf WraptextAutoCallback)
End Function

 

[ndu96081631]

Chào anh chị, anh chị cho em hỏi về Wrap text tí.

Ví dụ.
Tại ô A1 = giá trị ô B7.

khi B7 có len = 10 thì tự động Wrap text ô A1

Khi B7 có len = 50 thì tự động Wrap text ô A1.

Có cách nào tự động nó Wrap text mà không cần mình chỉnh thủ công hay không?

Em cảm ơn!

Khi B7 có len từ 11 đến 49 thì làm cái gì?

 

[ducdinh1987]

Khi B7 có len từ 11 đến 49 thì làm cái gì?

Nó tự wrap text khi độ dài càng tăng hay giảm thôi anh. Em làm được rồi. Cảm ơn anh Nhiều.

Bài đã được tự động gộp: 13/1/20

Có một cách duy nhất là dùng VBA thôi bạn.

Tham khảo code dưới đây:
Copy đoạn code dưới đây vào một Module trong VBE (Alt+F11)
(* VBA phải được Xác nhận độ tin cậy trong mục File/Options/Trust Center/Trust Center Setting... )
Thực hiện:

A1 = WrapAuto(B7, True)
Đối số TRUE/FALSE sẽ không hoặc Wrap cả ô B7
A1 = WrapAuto(B7) mặc định là FALSE

*Nhớ sửa lại tiêu đề để phù hợp ("Tự động WrapText khi giá trị một ô được gán thay đổi")
---------------

Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private WrapAutoCellCaller  As Range, WrapAutoCellValue  As Range, WTACC_TimerID&
Private Sub WraptextAutoCallback()
  On Error Resume Next
  KillTimer 0&, WTACC_TimerID: WTACC_TimerID = 0
  Application.ScreenUpdating = False
  WrapAutoCellCaller.WrapText = False
  WrapAutoCellCaller.WrapText = True
  If Not WrapAutoCellValue Is Nothing Then
    WrapAutoCellValue.WrapText = False
    WrapAutoCellValue.WrapText = True
    Set WrapAutoCellValue = Nothing
  End If
  Application.ScreenUpdating = True
  Set WrapAutoCellCaller = Nothing
End Sub
Function WrapAuto(ByVal CellValue As Range, Optional WrapCellValue As Boolean = False) As Variant
  WrapAuto = CellValue(1, 1).Value2
  Set WrapAutoCellCaller = Application.Caller
  If WrapCellValue Then Set WrapAutoCellValue = CellValue(1, 1)
  If CellValue(1, 1).HasFormula Then Application.Volatile
  If WTACC_TimerID <> 0 Then KillTimer 0&, WTACC_TimerID
  WTACC_TimerID = SetTimer(0&, 0&, 1, AddressOf WraptextAutoCallback)
End Function

Cảm ơn anh!!