The answer is, Excel doesn't have selectable line spacing. Sorry. Wish
it did.
Below is an alternative - overlay a text box over a cell to make it
into a 'comment/memo' area.
MB
Public Sub AddTextBox(Optional tSheetname, Optional tCell, Optional
tText)
'Add a box for long text into the current cell.
If Not IsMissing(tSheetname) And Not IsMissing(tCell) Then
Worksheets(tSheetname).Activate
Range(tCell).Select
End If
If TypeName(Selection) LT GT "Range" Then
Beep
Exit Sub
End If
Set oSelection = Selection
If IsMissing(tSheetname) And IsMissing(tCell) And IsMissing(tText)
Then
If MsgBox("Turn this cell into a long-text edit box?",
vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
End If
'Set to 100% zoom first, otherwise position co-ordinates get
screwed due to rounding errors
oZoom = Application.ActiveWindow.Zoom 'record active zoom so that
it can be set back at end
Application.ScreenUpdating = False
Application.ActiveWindow.Zoom = 100
BoxTop = RowTop(oSelection.Worksheet.Name, oSelection.Address)
With oSelection
Set NewBox = ActiveSheet.TextBoxes.Add(.Left, BoxTop, .Width,
Height)
NewBox.Interior.ColorIndex = .Interior.ColorIndex
If IsMissing(tText) Then
NewBox.Characters.Text = .Text
Else
NewBox.Characters.Text = ""
nStart = 1
While nStart LT= Len(tText)
NewBox.Characters(NewBox.Characters.Count).Insert
String:=Mid(tText, nStart, 254)
nStart = nStart + 253
Wend
While nStart GT= 1
'NewBox.Characters(NewBox.Characters.Count).Insert
String:=Mid(tText, nStart, 253)
nStart = nStart - 253
Wend
End If
NewBox.Border.LineStyle = xlNone
NewBox.Interior.Pattern = xlSolid
NewBox.Placement = xlMoveAndSize
NewBox.PrintObject = True
NewBox.Border.Color = oSelection.Borders(xlTop).Color
NewBox.Border.Weight = oSelection.Borders(xlTop).Weight
NewBox.Characters.Font.Name = oSelection.Font.Name
NewBox.Characters.Font.Size = oSelection.Font.Size
NewBox.Characters.Font.FontStyle = oSelection.Font.FontStyle
End With
Application.ActiveWindow.Zoom = oZoom
End Sub
Public Function RowTop(tWorksheet, tCell)
nRow = Range(tCell).Row
nTop = 0
If nRow GT 1 Then
For zRow = 1 To nRow - 1
nTop = nTop + Worksheets(tWorksheet).Cells(zRow, 1).Height
Next zRow
End If
RowTop = nTop
End Function