S
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
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