Tự động cắt, di chuyển nội dung tràn ô
- Thread starter lehoctk
- Ngày gửi
- Tham gia
- 4/11/07
- Bài viết
- 14,396
- Được thích
- 37,031
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Thử cắt bên trái 30 ký tự, còn bao nhiêu đưa xuống dưới.
left(công thức, 30)
right(công thức, Len(công thức) - 30)
Nếu 1 từ bị chẻ đôi, kết hợp thêm hàm find tìm khoảng trắng từ vị trí 30
left(công thức, 30)
right(công thức, Len(công thức) - 30)
Nếu 1 từ bị chẻ đôi, kết hợp thêm hàm find tìm khoảng trắng từ vị trí 30
Upvote
0
Vậy mong bác hướng dẫn giúp em sau khi gán textbox vào thì làm cách nào để tìm được vị trí trong nội dung bị tràn dòng ạ? Em cảm ơn bác rất nhiều.
Upvote
0
PHP:
'API Declares
'https://eileenslounge.com/viewtopic.php?t=13352
#If VBA7 Then
Private Declare PtrSafe Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare PtrSafe Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare PtrSafe Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare PtrSafe Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
#Else
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
#End If
Private Const LOGPIXELSY As Long = 90
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Function GetStringSize(text As String, font As StdFont) As SIZE
Dim tempDC As Long
Dim tempBMP As Long
Dim f As Long
Dim lf As LOGFONT
Dim textSize As SIZE
' Create a device context and a bitmap that can be used to store a
' temporary font object
tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
' Assign the bitmap to the device context
DeleteObject SelectObject(tempDC, tempBMP)
' Set up the LOGFONT structure and create the font
lf.lfFaceName = font.Name & Chr$(0)
lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72)
lf.lfItalic = font.Italic
lf.lfStrikeOut = font.Strikethrough
lf.lfUnderline = font.Underline
If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
f = CreateFontIndirect(lf)
' Assign the font to the device context
DeleteObject SelectObject(tempDC, f)
' Measure the text, and return it into the textSize SIZE structure
GetTextExtentPoint32 tempDC, text, Len(text), textSize
' Clean up (very important to avoid memory leaks!)
DeleteObject f
DeleteObject tempBMP
DeleteDC tempDC
' Return the measurements
GetStringSize = textSize
End Function
Public Function GetStringWidth(text As String, fontName As String, fontSize As Currency) As Long
Dim font As New StdFont
Dim sz As SIZE
font.Name = fontName
font.SIZE = fontSize
sz = GetStringSize(text, font)
GetStringWidth = sz.cx
End FunctionGiờ phải viết 1 đoạn lấy thông tin font chữa, chiều cao chữ, bề rộng của cột bên trên.
dùng (đoạn mã - source) bên trên trên để tính ra chiều dài (Pixels) của chuỗi.
PHP:
=GetStringWidth("NoiDung","Arial",11)Nếu chiều dài chuỗi lớn hơn thì cắt xuống. <-- đoạn này giờ thì muốn phải thêm vào, mà lười quá.
Upvote
0
- Tham gia
- 4/11/07
- Bài viết
- 14,396
- Được thích
- 37,031
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Theo hình chụp bài 1 thì phải 2 textbox, trong word làm được, Excel thì không thấy
Bài đã được tự động gộp:
Làm theo bài 2: Left, find và Right
Lần chỉnh sửa cuối:
Upvote
0
Bác ơi, với cách này thì chỉ áp dụng cho 1 font, size nhất định và phải tự đếm số ký tự có thể hiển thị trên 1 dòng bác nhỉ (như ở đây là 30 ký tự)
Bài đã được tự động gộp:
Cảm ơn bác ạ
Lần chỉnh sửa cuối:
Upvote
0
Mong muốn của em là tìm ra nội dung thừa so với độ rộng của cột bác ạ, nếu như hướng dẫn của bác thì chưa phù hợp lắm ạ
Upvote
0
- Tham gia
- 4/11/07
- Bài viết
- 14,396
- Được thích
- 37,031
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Nếu phải tự đếm mà cũng không muốn đếm, thì nên ở nhà cha mẹ nuôi. Khỏi đi làm cực khổ.
Upvote
0
Ý em là nó sẽ bị động ấy bác, nếu chỉ cần đếm 1 lần thì không sao, nhưng nếu các trường hợp thường xuyên có thay đổi thì mình lại phải thường xuyên cập nhật code vậy thì em nghĩ không nên dùng đến VBA.
Em cảm ơn bác đã góp ý,
Với TH của em, em thấy ở bài #6 đáp ứng được mong muốn của em bác ạ.
Upvote
0
- Tham gia
- 4/11/07
- Bài viết
- 14,396
- Được thích
- 37,031
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Tôi có xài VBA đâu. Còn đếm thì chỉ là nhẩm sơ qua, đâu phải đếm từng ký tự đâu. Ô rộng thì khoảng này, ô hẹp thì khoảng này, thử 1 lần là 30. điều chỉnh lên hoặc xuống 1 lần là xong.
Khổ lắm, cực lắm, "em" không làm đâu
Lần chỉnh sửa cuối:
Upvote
0
Mr.hieudoanxd
Thành viên thường trực
- Tham gia
- 25/10/19
- Bài viết
- 322
- Được thích
- 150
Về
Bạn sử dụng Wrap text nhưng mà ko sử dụng Merge & Center mà sử dụng tính Năng Center Across Selection nó vẫn tự động dãn ô, tự động xuống dòng cho bạn đấy. Thử mà xem
Upvote
0
- Tham gia
- 4/11/07
- Bài viết
- 14,396
- Được thích
- 37,031
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Consultant
Bạn không xem kỹ hình à? Ô trên chỉ là cột E kéo rộng, ô dưới trải từ A đến E.
dãn ô tự động xuống dòng chỉ trong 1 ô cột E thì nói làm gì.
Upvote
0
Mr.hieudoanxd
Thành viên thường trực
- Tham gia
- 25/10/19
- Bài viết
- 322
- Được thích
- 150
Ồ, em không đọc kỹ đề bài thật. Thứ lỗi nhé #1
Upvote
0
Bài viết mới nhất
- Question
- Question
