I am trying to build a VBA code that help build a text in a text box based on Radio choices (as in screen attached)
I want the lines- 1st or 2nd - in the texted box to changed based on the 1st question and it's answer.
I tried the codes below but none of them works
Sub Macro5()
'
' Macro5 Macro
'
'
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"1 No I am not here"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 32).ParagraphFormat. _
FirstLineIndent = 0
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 11).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(12, 21).Font
.BaselineOffset = 0
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
End Sub
In my oppion best idea is to create new UserForm for.ex
With options to Finish/Cancel/Change answer :)
And after final "Finish" just send it to range or cell :)
For TextBox, you will need to enable MultiLine.
For Option Buttons you will need to lock them and publish text or unlock them and delete text from TextBox if somebody clicks "Unlock/Change" near "Yes/No" options :).
Fro ex. code for Option Button
Private Sub OptionButton4_Click()
TextBox1.Text = TextBox1.Text & vbCrLf & "2. Yes the Sun is out" & vbCrLf 'vbCrLf stands for "next line"
OptionButton3.Locked = True
OptionButton4.Locked = True
End Sub
In my opion it's easiest and best idea for this work.
Related
I am simply trying to create a rectangle shape in a specific worksheet, formatting it & assign a macro to it using VBA.
Here goes my attempt :
Set t = wsJTO.Range("H" & 5 & ":G" & 6)
Set btn = wsJTO.Shapes.AddShape(msoShapeRectangle, t.Left, t.Top, t.Width, t.Height)
With btn.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
.Solid
End With
With btn.ShapeRange.ThreeD
.BevelTopType = msoBevelArtDeco
.BevelTopInset = 9
.BevelTopDepth = 6
End With
btn.OnAction = "Module2.Selection_JTO"
According to the debugger, there is an error with the third line & I don't seem to understand what's wrong with it. Help would be appreciated
Silly me ... All I had to do was get rid of "ShapeRange" since it doesn't have a fill property. The following code does the job if it might serve someone in the future :
Set t = wsJTO.Range("H" & 5 & ":G" & 6)
Set btn = wsJTO.Shapes.AddShape(msoShapeRectangle, t.Left, t.Top, t.Width, t.Height)
With btn.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
.Solid
End With
With btn.ThreeD
.BevelTopType = msoBevelArtDeco
.BevelTopInset = 9
.BevelTopDepth = 6
End With
btn.OnAction = "Module2.Selection_JTO"
I am trying to change the number in my text box.
My code so far looks like this:
Sub Box()
ActiveSheet.Shapes("Asbuilt_Number1").Copy
ActiveSheet.Range("C25").PasteSpecial
Selection.ShapeRange.TextFrame.textRange.Characters.text = "2"
Selection.Name = "Asbuilt_Number"
End Sub
what is based from the Macro
Sub Boxes_Two()
'
' Macro3 Macro
'
'
ActiveSheet.Shapes.Range(Array("Asbuilt_Number_1")).Select
Selection.Copy
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -0.75
Selection.ShapeRange.IncrementTop 347.25
Selection.ShapeRange(1).TextFrame2.textRange.Characters.text = "2"
With Selection.ShapeRange(1).TextFrame2.textRange.Characters(1, 1). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
End With
With Selection.ShapeRange(1).TextFrame2.textRange.Characters(1, 1).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 15
.Name = "+mn-lt"
End With
ActiveSheet.Shapes.Range(Array("Asbuilt_Number_1")).Select
Selection.ShapeRange.Name = "Asbuilt_Number"
Selection.Name = "Asbuilt_Number"
End Sub
I am unhappy with macro, since my copied number goes in completely different place, than I targeted.
My non-macro code throws error: Object doesn't support this property or method
at the line
Selection.ShapeRange.TextFrame.textRange.Characters.text = "2"
Even if I remove the Characters, likewise in the template below:
https://learn.microsoft.com/en-us/office/vba/api/project.shaperange.textframe2
How can I change the name of my textboxes swiftly?
This works for me, let's try the following code:
Note: ActiveSheet.Range("C25").Paste will not work
Sub Box()
With ActiveSheet
.Shapes("Asbuilt_Number1").Copy
[C25].Activate
.Paste
.Shapes(.Shapes.Count).Name = "Asbuilt_Number2"
.Shapes("Asbuilt_Number2").TextFrame2.TextRange.Characters.Text = "2"
End With
End Sub
I am currently building a macro that will create a Powerpoint from an excel workbook. I have two cells that I currently combine into one powerpoint textbox. I want to be able to bold one cell value in the textbox. Is this possible?
This is my current code:
Proj = Sheets("Bay du Nord").Range("A23")
Proj2 = Sheets("Bay du Nord").Range("B23")
Set LCProj = Slide2.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=210, Top:=265, Width:=110, Height:=100)
With LCProj
.Name = "LC Proj"
With .TextFrame.TextRange
.Text = Proj & vbNewLine & Proj2 & vbNewLine & "kg CO2/BOE"
.Font.Size = 12
.Font.Bold = False
.ParagraphFormat.Alignment = ppAlignCenter
End With
With .Fill
.TwoColorGradient msoGradientHorizontal, 2
.ForeColor.RGB = RGB(140, 0, 0)
.BackColor.RGB = RGB(180, 5, 0)
End With
.Shadow.Type = msoShadow14
End With
Say I want to bold the value that is in cell A23 (Proj) and leave the value in B23 (Proj2) the same.
Thanks
You can use TextRange.Characters() to change the properties of a subset of the original TextRange like so:
Proj = Sheets("Bay du Nord").Range("A23")
Proj2 = Sheets("Bay du Nord").Range("B23")
Set LCProj = Slide2.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=210, Top:=265, Width:=110, Height:=100)
With LCProj
.Name = "LC Proj"
With .TextFrame.TextRange
.Text = Proj & vbNewLine & Proj2 & vbNewLine & "kg CO2/BOE"
.Font.Size = 12
.Font.Bold = False
.ParagraphFormat.Alignment = ppAlignCenter
With .Characters(1, len(Proj))
.Font.Bold = True
End With
End With
With .Fill
.TwoColorGradient msoGradientHorizontal, 2
.ForeColor.RGB = RGB(140, 0, 0)
.BackColor.RGB = RGB(180, 5, 0)
End With
.Shadow.Type = msoShadow14
End With
I would like a textbox like this in my Excel spreadsheet:
I used this query: VBA Shapes.AddTextbox Method
I modified the code:
Sub asbuiltstamp()
Set myDocument = Worksheets(1)
myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
800, 50, 200, 75) _
.TextFrame.Characters.Text = "City Fibre As-Built"
.Font.ColorIndex = 3
.Font.Size = 20
.Font.HorizontalAlignment = xlCenter
.Shapes.Rotation = 45
.Shapes.Fill = False
End Sub
I get:
Compile error: Invalid or unqualified reference.
How can I customise my textbox with VBA Excel?
How can I set its own name (other than "Textbox1")?
You've tried to access several properties without specifying what they are properties of. You need something like this:
Sub asbuiltstamp()
Set myDocument = Worksheets(1)
With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 800, 50, 200, 75)
With .TextFrame
.HorizontalAlignment = xlCenter
With .Characters
.Text = "City Fibre" & vbLf & "As-Built"
With .Font
.Bold = True
.ColorIndex = 3
.Size = 20
End With
End With
End With
.Rotation = 45
.Fill.Visible = False
End With
End Sub
This is an excerpt of the code from the full macro. It operates correctly in most cases, however the color formatting is not applied when there is only one data series.
Sub fullPageLine()
Dim rng As Range
Dim cht As Object
Dim chart As chart
'Data range for the chart
'Set rng = Selection
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
'Create a chart
Set cht = Selection
'Format x axis
ActiveChart.ChartArea.Select
With Selection
.Format.TextFrame2.TextRange.Font.Name = "Arial"
.Format.TextFrame2.TextRange.Font.Size = 7
End With
'Format title
ActiveChart.ChartTitle.Font.Size = 8.4
ActiveChart.ChartTitle.Left = 0
ActiveChart.ChartTitle.Top = 2
ActiveChart.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Characters.Font
.BaselineOffset = 0
.Bold = msoTrue
.Size = 8.4
.Name = "Arial"
.Caps = msoAllCaps
End With
'Format legend
ActiveChart.Legend.Select
With Selection.Format.TextFrame2.TextRange.Font
.NameComplexScript = "Arial"
.NameFarEast = "Arial"
.Name = "Arial"
End With
Selection.Format.TextFrame2.TextRange.Font.Size = 7
'Change chart series fill color
With ActiveChart.FullSeriesCollection(1).Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
With ActiveChart.FullSeriesCollection(2).Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
With ActiveChart.FullSeriesCollection(3).Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
End With
The first data series should be in orange, and is whenever there are 2 or more lines on the chart. However, if it is a single line chart, it shows up in the default blue rather than orange. I am new to vba, and am aware that I need to get rid of select and activate, but am trying to get the base code to work first.
Your macro fails before assigning colors when there is only one series, because a chart with one series, by default, does not have a Legend.
Ensure that you have a legend in the chart (alternatively, use conditional logic to check whether Legend exists) before attempting to format the Legend.
Cleaned up to use object variables appropriately, and do your series formatting in a loop.
Option Explicit
Sub fullPageLine()
Dim rng As Range
Dim cht As chart
Dim i As Long, color As Long, bright As Double
Dim srs As Series
'Data range for the chart
'Set rng = Selection
Set cht = ActiveSheet.Shapes.AddChart2(227, xlLine).chart
'Format x axis
With cht.ChartArea.Format.TextFrame2.TextRange.Font
.Name = "Arial"
.Size = 7
End With
'Format title
With cht.ChartTitle
.Font.Size = 8.4
.Left = 0
.Top = 2
With .Format.TextFrame2.TextRange.Characters.Font
.BaselineOffset = 0
.Bold = msoTrue
.Size = 8.4
.Name = "Arial"
.Caps = msoAllCaps
End With
End With
'Format legend
cht.HasLegend = True
With cht.Legend.Format.TextFrame2.TextRange.Font
.NameComplexScript = "Arial"
.NameFarEast = "Arial"
.Name = "Arial"
.Size = 7
End With
' ALTERNATELY, instead of forcing the legend as per above:
'If cht.HasLegend Then
' With cht.Legend.Format.TextFrame2.TextRange.Font
' .NameComplexScript = "Arial"
' .NameFarEast = "Arial"
' .Name = "Arial"
' .Size = 7
' End With
'End If
'Change chart series fill color
For i = 1 To cht.FullSeriesCollection.Count
' Get the color based on series index
Select Case i
Case 1
color = msoThemeColorAccent2
Case 2
color = msoThemeColorText1
Case 3
color = msoThemeColorBackground1
bright = -0.5
End Select
' Assign series color formats
'## NOTE: This only works for the cases defined in the above Select statement.
Set srs = cht.FullSeriesCollection(i)
With srs.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = color
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = bright
.Transparency = 0
End With
Next
End Sub