Here is one rough and ready way that you can tune
In a standard code module add
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Declare Function PathCompactPath Lib "shlwapi.dll" _
Alias "PathCompactPathA" _
(ByVal hdc As Long, _
ByVal lpszPath As String, _
ByVal dx As Long) As Long
Private Declare Function PathCompactPathEx Lib "shlwapi.dll" _
Alias "PathCompactPathExA" _
(ByVal pszOut As String, _
ByVal pszSrc As String, _
ByVal cchMax As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Public Function MakeCompactedPathPixels(ByVal sPath As String, _
dwHdc As Long, _
dwPixels As Long) As String
Dim nReturn As Long
Dim sBuffer As String
'the path to compact and the return buffer are the same string
'and must be MAX_PATH in length
sBuffer = sPath & Chr$(0) & Space$(MAX_PATH - Len(sPath) - 1)
nReturn = PathCompactPath(dwHdc, sBuffer, dwPixels)
MakeCompactedPathPixels = TrimNull(sBuffer)
End Function
Private Function TrimNull(item As String) As String
Dim iPos As Long
iPos = InStr(item, vbNullChar)
TrimNull = IIf(iPos > 0, Left$(item, iPos - 1), item)
End Function
Then in your target worksheet add
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1:H10" '<== change to suit
Const MAX_LEN As Long = 25 '<== change to suit
Const MULTIPLIER As Long = 2.5 '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Len(.Value) > MAX_LEN Then
.Value = MakeCompactedPathPixels(.Value, 0, .Width *
MULTIPLIER)
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
Trevor Williams said:
Hi All
In XL2002, I'd like to be able to apply dot trailers to a cell if the text
in the cell is too long to fit with the current column width - much the
same
as it does in Windows Explorer.
e.g.
If the text in the cell read: "This is text in the cell but it's too long"
and the column width is set to 10, then the visible text would read
"This is text in a ce..."
An ideas, or pre-defind code I can use?
Thanks
Trevor Williams
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)