I am trying to manually set every OptionButton's font on a sheet to be a uniform size and type using a For Loop.
I can do them manually by writing out each specific button's information but I have hundreds of buttons.
I can even get VBA to write the correct syntax to a test Worksheet by using this code here:
`Private Sub Thisworkbook_Open()
For i = 1 to Worksheets("Core").OLEObjects.Count
If TypeName(Worksheets("Core").OLEObjects(i).Object) = "OptionButton" Then
Worksheets("testsheet").Range("A" & i).Value = Worksheets("Core").OLEObjects(i).Name
End If
Next i
End Sub`
But what I can't do is put the rest of this below code along with the above code to have ONE clean and concise statement that will manually set all OptionButton values to these settings:
`With Worksheets("Core").OptionButton1
.Font.Size = 11
.Font.Name = "Calibri"
.Font.Bold = False
End With`
Can someone explain to me how I can make this work?
Actually you have your answer in your question, all you have to do is to put your properties to correct location, as follows:
For i = 1 To Worksheets("Core").OLEObjects.Count
If TypeName(Worksheets("Core").OLEObjects(i).Object) = "OptionButton" Then
Worksheets("Core").OLEObjects(i).Object.FontSize = 5
' Remaining code goes here.
End If
Next i
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
I'd like to imitate the behavior of the default insert comment button with a macro. I want to store all of my macros in the Personal workbook, not the active workbook.
I'd like it to simply create a comment and then set the focus to that empty comment.
Below is what I have so far, using Terry's suggestion to make the comment .Visible and then .Shape.Select it:
Sub addNewComment()
Dim authorName As String
Dim authorNameLength As Integer
authorName = Application.UserName
authorNameLength = Len(authorName)
ActiveCell.AddComment _
authorName & ":" _
& Chr(10)
With ActiveCell.Comment
With .Shape
.AutoShapeType = msoShapeFoldedCorner
.Fill.ForeColor.RGB = RGB(215, 224, 239)
With .TextFrame
.AutoSize = True
.Characters.Font.Size = 11
.Characters.Font.Name = "Calibri"
.Characters(1, (authorNameLength + 1)).Font.Bold = True
.Characters((authorNameLength + 2), 1).Font.Bold = False
End With
End With
.Visible = True
.Shape.Select True
End With
End Sub
I'm not sure how to get the comment to go back to not being visible. Do I store the reference to the cell I just added the comment to, and then refer to that cell with the Worksheet_SelectionChange event? Or do I make that event just hide all comments on the sheet? Is it possible to use Worksheet_SelectionChange at all with the Personal workbook?
Also, my comment box does not resize as I type and add line breaks. It does resize after I exit, but actually too large by about four lines. Not sure why that is happening.
I'm sure there is a cleaner way to organize my With blocks as well.
I tried using the following to hide the comment again after selecting another cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Comment.Visible = False
End Sub
I received the following error:
error 91: Object variable or With block variable not set
You can select the comment once you make it visible using the following:
With range("a1")
.Comment.Visible = True
.Comment.Shape.Select True
End With
But I think you'll need to have another macro to hide the comment again once you deselect, as otherwise it will stay visible. You could try doing this on the SelectionChange event of the worksheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Comment.Visible = False
End Sub
I have a report in which I am asking the users to click buttons to reveal where they need to add their commentary. I have it working but wanted to put in an If statement in case they have already expanded the row.
I have two macros, the first relates to the button they push and sends to the main macro the name of the button and a row number which is part of the section that is either expanded or collapsed
Sub ROccupancy()
'
Dim RecName As String
RecName = "ROccupancy"
Dim RowNum As Integer
RowNum = 27
Call ToogleRec(RecName, RowNum)
End Sub
The next macro is where I am having the trouble
Sub ToogleRec(RecName, RowNum)
'
Dim Toogle As String
Dim MyObj As Object
Set MyObj = ActiveSheet.Shapes.Range(Array(RecName))
Toogle = Left(MyObj.TextFrame2.TextRange.Characters.Text, 4)
TextName = Mid(MyObj.TextFrame2.TextRange.Characters.Text, 5, 100)
If Toogle = "Show" Then
MyObj.ShapeStyle = msoShapeStylePreset9
MyObj.TextFrame2.TextRange.Characters.Text = _
"Hide" & TextName
MsgBox Rows(RowNum).ShowDetail
If Rows(RowNum).ShowDetail = False Then
Rows(RowNum).ShowDetail = True
End If
Else
MyObj.ShapeStyle = msoShapeStylePreset11
MyObj.TextFrame2.TextRange.Characters.Text = _
"Show" & TextName
MsgBox Rows(RowNum).ShowDetail
If Rows(RowNum).ShowDetail = True Then
Rows(RowNum).ShowDetail = False
End If
End If
Range("C" & RowNum).Select
End Sub
The issue is the Rows(RowNum).ShowDetail is always TRUE, no matter if it's expanded or collapsed. I can remove the If section and set it to TRUE or FALSE using "Rows(RowNum).ShowDetail = False" or "Rows(RowNum).ShowDetail = TRUE". However, if the user has manually expanded or collapsed the row it causes an error (which freaks them out)
This question and answer seemed promising but Rows(RowNum).ShowDetail always seems to be TRUE
I put the MsgBox in there for error checking. I'll remove it in the final version.
Have you tried using Hidden property? Something like:
With Sheet1.Rows(5)
.ShowDetail = .Hidden
End With
Take note though that for you to use .ShowDetail method, you'll need to Group the rows first (needs to be in outline form).
True if the outline is expanded for the specified range (so that the detail of the column or row is visible). The specified range must be a single summary column or row in an outline.
Above code toggles hiding/unhiding a grouped row 5. You don't even need an If statement for the toggling. HTH.
I shamelessly recorded a macro to amend the default heading styles 2 - 5 to change their .NextParagraphStyle to ones of my own making called Normal_lvl2, Normal_lvl3 etc :
With ActiveDocument.Styles("Heading 2").ParagraphFormat ' etc etc
.LeftIndent = CentimetersToPoints(1.13)
.RightIndent = CentimetersToPoints(0)
.LineSpacingRule = wdLineSpaceDouble
.Alignment = wdAlignParagraphLeft
.FirstLineIndent = CentimetersToPoints(-0.63)
.OutlineLevel = wdOutlineLevel2
.NoSpaceBetweenParagraphsOfSameStyle = False
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal_lvl2" ' here is the next style
End With
Problem is the document doesn't actually update the next paragraph style, either when I run the macro or set a style for a line manually. The new style works fine for the actual header line but the next paragraph is not changed.
I did try to loop through all paragraphs and set the style but it took far too long (I quit after 20 mins run time, the doc is 160 pages). Specifically I got all headings into an array, used Find to return a range for each of the headers in the array and set the next range style depending on the heading level. Maybe not the best way but I'm not too familiar with the Word Object Model.
So my question is - is there an efficient way to automate the application of my custom styles and to ensure the next paragraph style is also changed?
You should iterate over all paragraphs in your document and then adjust the following paragraph accordingly like it is done in the following sample:
Sub ChangeParagraphsAfterHeading()
Dim para As Paragraph
Dim nextPara As Paragraph
For Each para In ActiveDocument.Paragraphs
If para.Style = "Heading 2" Then
Set nextPara = para.Next
If Not nextPara Is Nothing Then
nextPara.Style = "Normal_lvl2"
End If
End If
Next
End Sub
I assume that you probably want to adjust the style for all paragraphs between two headings. The sample above doesn't do that yet, but it should get you started.
This question already has answers here:
Microsoft Excel ActiveX Controls Disabled?
(11 answers)
Closed 8 years ago.
I have been using this excel program for several months without issues. suddenly a couple days ago it started to throw this error. On sheet named "Input" I will double click a cell in column "A" which will create a drop down box that will fill with data from the "Data" sheet. I start typing and then I select the data to add to the cell. Now when I click the cell and get an error message "Compile Error - Method or data member not found". Here is my block of code and the error is showing near the bottom highlighting "Me.TempCombo.Activate".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
If Target.Column = 1 And Target.Row > 12 And Target.Row <> HRRow And Target.Row <> HRRow - 1 Then
lRow = Sheets("Data").Range("A65536").End(xlUp).Row
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
'If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Cancel = True
Application.EnableEvents = False
'get the data validation formula
'str = Target.Validation.Formula1
'str = Right(str, Len(str) - 1)
str = "=Data!A2:A" & lRow
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
'cboTemp.Activate
Me.TempCombo.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
I tried several things and for the life of me I cannot figure out what changed.
Any help will be appreciated. Thank you.
I ran into the same error and was able to solve it as Rory suggested. I searched my machine for *.exd files and found a few. The issue was solved for me after removing C:\Users\<username>\AppData\Local\Temp\Excel8.0\MSForms.exd...the others seemed to be unrelated to the ActiveX controls in Excel.
Looks like the code came from an example like this: http://www.contextures.com/xlDataVal10.html
except your code has commented out the line which activates the cboTemp combobox. Your code is attempting to access the TempCombo attribute of the worksheet (which I don't think exists). Uncomment 'cboTemp.Activate on the line above the highlighted error line.
I had the same problem, my code broke this morning. Fortunately, I recalled that I ran Windows Update this weekend. I performend a system restore (earliest available restore point was 8th of december), and now the problem is gone.
I never did understand the panicy server guys who were always making backups and spending a whole lot of time testing before/after system updates, in all my years I never experienced any problems. Now I sure figured out what they were talking about. Lesson learnt. I'll try running win update again in a few months, hopefully MS has solved the problem by then.
Best of luck