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.
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 am trying to read a table from a worksheet and storing in an listobject. I need to use this table data multiple time and I dont want to access worksheet every time I need table data. I think accessing worksheet everytime will slow down the performance.
Also I need to refer table data based on header name.
I was thinking of writing something like this.
public Tbl_MyTable as listobject
public Arr as variant
Set Tbl_MyTable = Workbooks("Myworkbook").worksheets("Myworksheet").ListObjects("Tbl1")
tRows = Tbl_MyTable .DataBodyRange.Rows.Count
for i=1 to 10
config= ArrConfig(i)
call readtable(tRows, config)
Set Destination = workbooks("x").sheets("y").Range("A2")
Destination.Resize(1,UBound(Arr, 1)).Value = Arr
'Create the table based on the populated data.
Set populated_area = Destination.CurrentRegion
Set Create_Table = .ListObjects.Add(xlSrcRange, populated_area, , xlYes)
Create_Table.name = (.name & "_tbl")
Create_Table.TableStyle = "TableStyleMedium15"
'Select this newly created table and do some data reformating
With ActiveSheet.ListObjects("" & Tbl_name & "").Range.Select
'Change entire Table font
With Selection.Font
.name = "Calibri Light"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMajor
End With
End with
...
...
...
'Inside Sub readtable
For i = 1 To tRows
if config= A
Arr(i) = Range("Tbl_MyTable[Header1]")(i).Value
else if config =B
Arr(i) = Range("Tbl_MyTable[Header2]")(i).Value
else
Arr(i) = Range("Tbl_MyTable[Header3]")(i).Value
end if
.
.
Problem is that it works only for first iteration of top level loop.
Next time I get following error (Somehow I am getting multiple errors every time I run it. Not all appear everytime)
Run-time error '1004' : Method 'Range' of object'_Global' failed
Error number: 90 Subscript out of range
Any idea what might be wrong here. I guess looking this code again and again I am hitting a wall now. I need another set of eyes to help me.
I have an XY scatter chart with seven data series on it (using Office 365). I am trying to set the format for the data series using VBA, and it all works fine with the exception that the first series is inexplicably linked to the seventh series. The code looks something like this:
'Series 0
With Sheet1.ChartObjects("MyChart").Chart.FullSeriesCollection("Type_0")
With .Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
End With
.Format.Glow.Radius = 0
.Format.Line.Visible = msoFalse
.MarkerStyle = 1
End With
'Series 1 to 6
For i = 1 To 6
With Sheet1.ChartObjects("MyChart").Chart.FullSeriesCollection("Type" & i)
.MarkerStyle = -4105 'On
.Format.Line.Visible = msoFalse
With .Format.Glow
.Radius = 0
.Color.ObjectThemeColor = msoThemeColorAccent6
.Color.TintAndShade = 0
.Color.Brightness = 0
.Transparency = 0
.Radius = 5
.Color.RGB = RGB(105, 211, 33)
End With
With .Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With
End With
Next i
It doesn't matter which order I put those blocks in, or even if I try to adjust the series formatting manually in the Format Shape window, anytime I try to change Series7, the exact same change applies to Series0 and vice versa.
What kind of awful setting have I enabled that makes that happen, and how do I turn it off?
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
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