When I try to make the text font bold with
ActiveSheet.Range("C2:G2").Select
With Selection
.Merge
.Value = "Dealer Commission Rate"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Font.Name = "Arial"
.Font.Size = 11
.Font.Bolt = True
End With
in VB6, I keep getting this warning:
"The selection contains multiple data value. Merging into one cell
will keep the upper-left most data only"
Another problem because of the line .Font.Bolt = True,
error#:438 "Object doesn't support this property or method.
How can I suppress the warning and get the text font bolt?
You are writing
.Font.Bolt = True
Try
.Font.Bold = True
Related
I am trying to copy the contents (text and format) from a text box on one sheet to another text box on another sheet within the same workbook. I have been able to successfully copy over almost everything, but the justification (center/left/right) is not working for each individual line. I am doing this in a very clunky way: copy the text, then loop through each character to get the format set. There does not seem to be an easy way in excel vba to copy both the text and ALL of the format over. Essentially I am trying to do a "select all (Cntrl-A)", "copy (Cnrl-C)" on the origin textbox, then do a "paste special (keep source formatting)" on the destination text box. IT works wonderfully using the mouse, but I do not want to do that. I just want to run a macro to do the same thing. Also, I noted that when the macro runs, the destination text box applies justification global to the text and I am no longer able to individually select a single line and set its justification (i.e. either all lines are centered or all lines are left justified vs. being able to adjust each line individually). Again, this weird behavior only happens after the macro is run. If I use the mouse cut-and-paste method, the text is able to be justified line-by-line again. Here is my clunky code:
Sub Update_CARD_LEG_BACK()
' Set varibles to reduce typing and make changing origin and destination text boxes easier.
Set Orig = Sheets("MAIN_INPUT2").Shapes("CARD_LEG_BACK")
Set Orig_Sheet = Sheets("MAIN_INPUT2")
Set Dest = Sheets("CARD_LEGACY").Shapes("BACK")
Set Dest_Sheet = Sheets("CARD_LEGACY")
'Copy text from origin text box to destination text box. Copies only the text NO formating.
Dest.TextFrame.Characters.Text = Orig.TextFrame.Characters.Text
For i = 1 To Len(Orig.TextFrame.Characters.Text)
Dest.TextFrame.Characters(i, 1).Font.Underline = Orig.TextFrame.Characters(i, 1).Font.Underline
With Dest.TextFrame2.TextRange.Characters(i, 1)
.Text = Orig.TextFrame2.TextRange.Characters(i, 1).Text
With .Font
.Name = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Name
.Size = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Size
.Bold = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Bold
.Strikethrough = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Strikethrough
.Superscript = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Superscript
.Subscript = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Subscript
.Fill.ForeColor.RGB = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Fill.ForeColor.RGB
.Fill.BackColor.RGB = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Fill.BackColor.RGB
.Fill.Visible = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Fill.Visible
.Fill.Transparency = Orig.TextFrame2.TextRange.Characters(i, 1).Font.Fill.Transparency
End With
With .ParagraphFormat
.BaselineAlignment = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.BaselineAlignment
.SpaceWithin = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.SpaceWithin
.SpaceBefore = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.SpaceBefore
.SpaceAfter = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.SpaceAfter
.IndentLevel = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.IndentLevel
.FirstLineIndent = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.FirstLineIndent
.Alignment = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.Alignment
.HangingPunctuation = Orig.TextFrame2.TextRange.Characters(i, 1).ParagraphFormat.HangingPunctuation
End With
End With
Next i
'Copy fill color of origin text box to destination text box. Also copies transparancy (required for 'no fill' option to copy correctly).
Dest.Fill.ForeColor.RGB = Orig.Fill.ForeColor.RGB
Dest.Fill.Transparency = Orig.Fill.Transparency
End Sub
You could replace the second with a copy of the first:
Sub Tester()
ReplaceWithCopy Sheet1.Shapes("SourceTB"), Sheet2.Shapes("DestTB")
End Sub
Sub ReplaceWithCopy(shpSrc As Shape, shpDest As Shape)
Dim nm As String
shpSrc.Copy
shpDest.Parent.Paste
With shpDest.Parent.Shapes(shpDest.Parent.Shapes.Count)
.Left = shpDest.Left
.Top = shpDest.Top
.Width = shpDest.Width
.Height = shpDest.Height
nm = shpDest.Name
shpDest.Delete 'remove the shape being replaced
.Name = nm 'rename copy to just-deleted shape
End With
End Sub
I have the below working code. I added the With statement but it formats all text on page.
This code takes each row from an excel table and extracts the column header (question) and the cell value (answer) just below it.
My goal is to have the question in bold and one font size and the answer below it normal font and a smaller size.
I tried wrapping the With statement around just the header code but it still stylizes the entire page
For Each cell In tbl.DataBodyRange.Rows:
If cell.EntireRow.Hidden = False Then
hiddenCell = cell.Row
For Each Header In tbl.HeaderRowRange:
With WordDoc
.Styles(wdStyleHeading1).Font.Name = "Arial"
.Styles(wdStyleHeading1).Font.Size = 12
.Styles(wdStyleHeading1).Font.Bold = True
.Styles(wdStyleHeading1).Font.Color = wdColorBlack
.Range(0).Style = .Styles(wdStyleHeading1)
headerCol = wks.Cells.Find(Header).Column
WordDoc.Content.InsertAfter (vbNewLine)
WordDoc.Content.InsertAfter Range(Header.Address).Value & ": "
WordDoc.Content.InsertAfter (vbNewLine)
WordDoc.Content.InsertAfter (Cells(hiddenCell, headerCol).Value)
'WordDoc.Content.InsertAfter (vbNewLine)
End With
Next
WordDoc.Sections.Add
To begin with you need to take defining Heading 1 out of the loop. You only need to define a style once.
You also format the document with the Heading 1 style within the loop. Again this does not need to be repeated.
What your code does not do is apply any other style to the answers.
I have redrafted your code setting both the text and the style for the last paragraph.
With WordDoc
With .Styles(wdStyleHeading1).Font
.name = "Arial"
.Size = 12
.Bold = True
.Color = wdColorBlack
End With
.Range(0).style = .Styles(wdStyleHeading1)
End With
For Each Cell In tbl.DataBodyRange.Rows:
If Cell.EntireRow.Hidden = False Then hiddenCell = Cell.Row
For Each Header In tbl.HeaderRowRange:
With WordDoc
headerCol = wks.Cells.Find(Header).Column
.Content.InsertAfter (vbNewLine)
With .Paragraphs.Last.Range
.Text = Range(Header.Address).Value & ": "
.style = wdStyleHeading1
End With
.Content.InsertAfter (vbNewLine)
With .Paragraphs.Last.Range
.Text = Cells(hiddenCell, headerCol).Value
.style = wdStyleNormal
End With
End With
Next Header
WordDoc.Sections.add
Next Cell
I have managed with input the textbox to the formula, as per the following query, which I raised a while ago...
VBA Excel how to write Excel formula in the textbox
and everything is fine, but I have got problems with input the proper font features into this textbox.
Basically I have two separate sets of code, which I would love to combine into the one
Sub Duct1()
Set myDocument = ActiveSheet
With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 140, 180, 30)
.name = "Duct1"
With .TextFrame
.HorizontalAlignment = xlLeft
With .Characters
.Text = "1W-20mm/90' upturn"
.Font.ColorIndex = 3
.Font.Size = 16
.Font.Bold = True
End With
End With
.Rotation = 25
.Fill.Visible = False
.Line.Visible = False
End With
End Sub
Sub Duct1Desc()
ActiveSheet.Shapes("Duct1").OLEFormat.Object.Formula = "=AB1"
End Sub
For the second code I tried also:
Sub Duct1Desc()
ActiveSheet.Shapes("Duct1").OLEFormat.Object.Formula = "=AB1"
With ActiveSheet.Shapes("Duct1")
.Font.ColorIndex = 3
.Font.Size = 16
.Font.Bold = True
End With
End Sub
But in this issue I have got an error, that VBA doesn't support this property or method.
Can anyone help me to bind these 2 codes together?
Thanks
This works for me:
Dim s As Shape
Set s = ActiveSheet.Shapes("myBox")
s.DrawingObject.Formula = "=B2"
OK I thought the problem was the linking, not the formatting: this works for me.
Sub Duct1Desc()
Dim s
Set s = ActiveSheet.Shapes("Duct1")
s.OLEFormat.Object.Formula = "=A1"
With s.DrawingObject
.Font.ColorIndex = 3
.Font.Size = 20
.Font.Bold = True
End With
End Sub
I am running an Excel macro in a C# program.
I have a chart and I'd like to change its properties.
Here's the code I've tried:
ActiveSheet.ChartObjects("myChart").Activate
ActiveChart.Axe(xlCategory).Select
With Selection.Format.TextFrame2.TextRange.Font 'Run-Time error: method of object failed
.BaselineOffset = 0
.Bold = msoTrue
.Size = 12
.Italic = msoFalse
End With
However using the With-EndWith statemnt is giving me a run-time error.
Therefore, I'd like to know if there is any code that is equivalent to the code above. I am using Excel 2013.
if your goal is to simply change TickLabels font, may try something like this
ActiveSheet.ChartObjects("myChart").Activate
Dim Axx As Axis
Set Axx = ActiveChart.Axes(xlCategory)
With Axx.TickLabels.Font
.Bold = True
.Size = 12
.Name = "Bookman Old Style"
.Italic = False
.Color = RGB(255, 0, 0)
End With
I am working on a VBA Excel script that uses a pivot table to create a bunch of charts and copy them into a Word document, creating a report.
The charts come in pairs and, after pasting them, there's a slight "distance" between the y-axes.
I wish to have them make a single line if they were extended.
I'm using the TickLables.Offset property. It's set to the same value in both charts, yet that doesn't do the trick.
Any suggestions are welcome.
Edit:
A screenshot of the issue:
Code:
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection.TickLabels
.Offset = 500
End With
Since Offset is an inter percentage, as in .Axes(xlValue).TickLabels.Offset it is hard to pin down. To align things, in my case within a single chart, I get perfect results with:
.Legend.Left = .PlotArea.Left + .PlotArea.Width - .PlotArea.InsideWidth
.Legend.Width = .PlotArea.InsideWidth
In other words when you have TickLables only on the left (or right), the width of the Ticklables is the difference between the inside and outside Widths.