Excel VBA changing the text within the textbox - excel

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

Related

Building a text in TextBox based on Radio choices in VBA

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.

VBA & Excel: Selecting the row below a selection

I know this question may get asked a lot, but I haven't been able to find or understand the answer for exactly what I am looking for.
I am learning VBA in excel for the first time today and I am trying to auto-format a table of values and want this to work on different range sizes.
I am stuck on how to select the row underneath the last row in my selection and format it.
My code so far is:
Selection.CurrentRegion.Select
Selection.Rows("1:1").Interior.Color = 12155648
With Selection.Rows("1:1").Font
.ThemeColor = xlThemeColorDark1
.Bold = True
End With
Selection.CurrentRegion.Select
Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Select
Selection.Interior.Color = 12632256
Selection.Font.Bold = True
Selection.Range("A1").Value = "Total"
What I want to happen:
Original
Desired Formatting
What about making it into an actual table
Sub Demo()
With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveCell.CurrentRegion, , xlYes)
.Name = "MyTable" ' optional
.ShowTotals = True
End With
End Sub
Before
After
No, it isn't a common question because most programmers learn on their second day (that's tomorrow in your schedule) not to "Select" anything and use the Range object instead. Then your code would look more like this:-
Private Sub Snippet()
Dim Rng As Range
With Selection.CurrentRegion
.Rows(1).Interior.Color = 12155648
With .Rows(1).Font
.ThemeColor = xlThemeColorDark1
.Bold = True
End With
Set Rng = ActiveSheet.Cells(.Row + .Rows.Count, .Column).Resize(1, .Columns.Count)
End With
With Rng
.Interior.Color = 12632256
.Font.Bold = True
.Cells(1).Value = "Total"
End With
End Sub
You may use the following method, assuming your table start from B4:
Sub ty()
Dim lastrow As Long
lastrow = Sheet1.Range("B4").End(xlDown).Row + 1
With Sheet1.Range("B4").Resize(1, 5)
.Interior.Color = 12155648
.Font.ThemeColor = xlThemeColorDark1
.Font.Bold = True
End With
Sheet1.Cells(lastrow, 2).Value = "Total"
With Sheet1.Cells(lastrow, 2).Resize(1, 5)
.Interior.Color = 12632256
.Font.Bold = True
End With
End Sub

TextBox object customisation - Compile error: Invalid or unqualified reference

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

VBA code to bold all numbers within a selection in a textbox?

I have code to change selected text's font to Arial and size 10, it's quite simple:
Sub Arial10()
With Selection.ShapeRange.TextFrame2.TextRange.Font
.name = "Arial"
.Size = 10
End With
End Sub
How can I add to this macro to bold any numbers and dashes ("-") within this selection?
Here it goes....
Sub Arial10()
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Name = "Arial"
.Size = 10
End With
'-----BOLD all numbers and dashes-----
With Selection.ShapeRange.TextFrame2.TextRange
Dim i As Long
For i = 1 To Len(.Text)
If Mid(.Text, i, 1) Like "#" Or _
Mid(.Text, i, 1) = "-" Then
.Characters(i, 1).Font.Bold = True
End If
Next
End With
End Sub
Another take:
Sub Arial10andBoldStuff()
Dim shp As ShapeRange
Dim i As Long
Dim Char As Object
Set shp = Selection.ShapeRange
With shp.TextFrame2.TextRange
With .Font
.Name = "Arial"
.Size = 10
End With
For i = 1 To .Characters.Count
Set Char = .Characters(i, 1)
If IsNumeric(Char) Or Char = "-" Then
Char.Font.Bold = True
End If
Next i
End With
End Sub
Setting the shape to a variable is helpful for getting the Intellisense.

Excel 2003 VBA - Method to duplicate this code that select and colors rows

so this is a fragment of a procedure that exports a dataset from access to excel
Dim rs As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objxls As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Set rs = CurrentDb.OpenRecordset("qryOutput", dbOpenSnapshot)
intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
Set objxls = New Excel.Application
objxls.Visible = True
With objxls
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
With objSht
On Error Resume Next
.Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol)).CopyFromRecordset rs
.Name = conSHT_NAME
.Cells.WrapText = False
.Cells.EntireColumn.AutoFit
.Cells.RowHeight = 17
.Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
End With
.Rows("1:1").Select
With Selection
.Insert Shift:=xlDown
End With
.Rows("1:1").Interior.ColorIndex = 15
.Rows("1:1").RowHeight = 30
.Rows("2:2").Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
.Rows("4:4").Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
.Rows("6:6").Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
.Rows("1:1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End With
End If
Set objSht = Nothing
Set objWkb = Nothing
Set objxls = Nothing
Set rs = Nothing
Set DB = Nothing
End Sub
see where I am looking at coloring the rows. I wanted to select and fill (with any color) every other row, kinda like some of those access reports. I can do it manually coding each and every row, but two problems: 1) its a pain 2) i don't know what the record count is before hand.
How can I make the code more efficient in this respect while incorporating the recordcount to know how many rows to "loop through"
EDIT: Another question I have is with the selection methods I am using in the module, is there a better excel syntax instead of these with selections....
.Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
End With
is the only way i figure out how to accomplish this piece, but literally every other time I run this code, it fails. It says there is no object and points to the .font ....every other time? is this because the code is poor, or that I am not closing the xls app in the code? if so how do i do that?
Thanks as always!
Use conditional formatting. Here's a small piece of your code rewritten
On Error Resume Next
With .Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol))
.CopyFromRecordset rs
.FormatConditions.Add xlExpression, , "=MOD(ROW(),2)=1"
With .FormatConditions(1)
.Interior.Color = vbYellow
End With
End With
You should ask your selection question in a new question, but the answer will be: whenever you see .Select followed by With Selection, you probably don't need to select.
With Cells.Font
.Name = "Calibri"
.Size = 10
End With
You don't need to select all range for CopyfromRecordset, just Range("A1").CopyfromRecordset rs is enought and for what i see, you could just select your data instead of all column.
For i = 2 to 6 Step 2
With Range(Cells(1,i),Range(Cells(1,i)).End(xlDown)).Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
Next i
And for the second question #DickKusleika is right.

Resources