Display Text in Drawing Object - (in Rectangle box) <SHAHZAD>

[Shazi]

Hi Every one,

Suppose I have some Company information in the following cells in
Sheet1.
A1= company name,
A2= Address,
A3, Phone No.,
A4= Fax No.
etc.....

I want to display this information in a formatted shape in the Drawing
Object (Ractangle box) in the Sheet2 or any where else... pls help me
out how to this.

for reference I am giving you the below example from the Excel 2000
Template "Expense Statement" you can see this sample there. I want to
make the same function in my workbook, but this code is not working
with me. I think its not a big deal, but the Village Software Company
try to make it very difficult ways.

Regards.

Shahzad


Sub PreviewPane()
'Adds text into the preview panels dynamically

Dim Len1 As Integer
Dim String1 As String
Dim Thisbox As Variant
Dim LoopA As Integer

'Application.ScreenUpdating = False

Len1 = Sheets(Vital).Range("vital1").Characters.Count

If Not IsEmpty(Range("vital4")) And Not IsEmpty(Range("vital5"))
Then
Comma = ", "
Else
Comma = ""
End If

If Not IsEmpty(Range("vital9")) Then
Fax = " fax "
Else
Fax = ""
End If

String1 = Sheets(Vital).Range("vital1").Value & Chr(10) _
& Sheets(Vital).Range("vital2").Value & Chr(10) _
& Sheets(Vital).Range("vital4").Value & Comma & Sheets(Vital).Range
("vital5").Value & " " & Sheets(Vital).Range("vital6").Value _
& Chr(10) & Sheets(Vital).Range("vital8").Value & Fax & Sheets
(Vital).Range("vital9")

On Error GoTo Err_2B

For Each ThisSheet In Sheets
If TypeName(ThisSheet) = cWorksheet Then

ThisSheet.DrawingObjects("LT").Characters.Text = String1

If Err_Flg = False Then
With ThisSheet.DrawingObjects("LT").Characters.Font
.Name = LetterFont
.ColorIndex = LetterColor
.Size = LetterSize
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.FontStyle = LetterStyle
End With

With ThisSheet.DrawingObjects("LT").Characters(Start:=1,
Length:=Len1).Font
.Size = LetterSize + 10
.FontStyle = LetterStyle
End With

Else
Err_Flg = False
End If
End If
Next

On Error GoTo 0
'Application.ScreenUpdating = True
Exit Sub

Err_2B:

If Err <> 1004 And Err <> 1006 Then

Msg = Univ_Error & Str(Err) & ": " & Error(Err)
MsgBox Msg, vbCritical, SheetBar
Err = 0
Else
Err_Flg = True
Err = 0
Resume Next
End If

On Error GoTo 0
'Application.ScreenUpdating = True

End Sub

 

[joel]

There are too many places in this code where you may be having problems. the
code depends on a lot of different Named Ranges and has a lot of error
trapping that wil prevvent errors from being displayed when they occur. I
recommend stepping through the code and posting where the error is occuring.

Go to VBA window and click on 1st line with the mouse. then step through
the code by pressing F8. You are probably getting either an error 1004 or
1006 which indicates that and object or defined name doesn't exist.