Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Display Text in Drawing Object - (in Rectangle box) <SHAHZAD
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Display Text in Drawing Object - (in Rectangle box) <SHAHZAD
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. "Shazi" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Text in a Rectangle Object | Excel Programming | |||
How do I hlookup a text document object and then display it? | Excel Worksheet Functions | |||
Rectangle object in Worksheet not amenable to word indenting and Undo problems | Excel Discussion (Misc queries) | |||
Copy Rectangle Object From One Sheet To Another | Excel Discussion (Misc queries) | |||
Drawing Object | Excel Programming |