I know how to close all the groups at once using outline in the VBA like this:
'''' Close outline groups.
With sh.Outline
.ShowLevels _
RowLevels:=1, _
ColumnLevels:=1
End With
I also know how to open all the groups at once using outline in the VBA like this:
'''' Open outline groups.
With sh.Outline
.ShowLevels _
RowLevels:=2, _
ColumnLevels:=2
End With
But, how on earth can I open/close a single group!? And how do I detect if it is opened/closed!?
You can use these two code snippets as starting point:
Public Function isCollapsed(c As Range) As Boolean
isCollapsed = c.EntireRow.ShowDetail
End Function
Public Sub collapse(c As Range)
With c.EntireRow
If .ShowDetail = False Then
.ShowDetail = True
End If
End With
End Sub
You pass the cell which you want to check to the sub/function
Related
I am using Ms-Access and I created a userform which has a number of Textboxes on it. The boxes are named: Box1, Box2, Box3 ...
I need to loop through all boxes, but I don't know which is the last one. To avoid looping through all userform controls I thought of trying the following:
For i =1 To 20
If Me.Controls("Box" & i).value = MyCondition Then
'do stuff
End If
Next i
This errors at Box6, which is the first box not found. Is there a way to capture this error and exit the loop when it happens.
I know I could use On Error but I 'd rather capture this specific instance with code instead.
Thanks,
George
A Controls collection is a simplified collection of controls (obviously) and share a same order as a placement order of controls.
First of all, even a creatable collection object lacks methods such as Exists or Contains , hence you need a function with error handling to checking/pulling widget from a collection.
Public Function ExistsWidget(ByVal Name As String) As Boolean
On Error Resume Next
ExistsWidget = Not Me.Controls(Name) Is Nothing
On Error GoTo 0
End Function
If you really doesnt like "ask forgiveness not permission" option you can pull entire ordered collection of your textboxes (and/or check existance by name in another loop with similar logic).
Public Function PullBoxes() As Collection
Dim Control As MSForms.Control
Set PullBoxes = New Collection
For Each Control In Me.Controls
If TypeOf Control Is MSForms.TextBox And _
Left(Control.Name, 3) = "Box" Then
Call PullBoxes.Add(Control)
End If
Next
End Function
Since names of widgets are unique - you can return a Dictionary from that function with (Control.Name, Control) pairs inside and able to check existance of widget by name properly w/o an error suppression.
There's a good guide to Dictionary if it's a new information for you.
Anyway, no matter what object you choose, if user (or code) is unable to create more of thoose textboxes - you can convert this Function above to a Static Property Get or just to a Property Get with Static collection inside, so you iterate over all controls only once (e.g. on UserForm_Initialize event)!
Public Property Get Boxes() As Collection
Static PreservedBoxes As Collection
'There's no loop, but call to PullBoxes to reduce duplicate code in answer
If PreservedBoxes Is Nothing Then _
Set PreservedBoxes = PullBoxes
Set Boxes = PreservedBoxes
End Property
After all, the last created TextBox with name Box* will be:
Public Function LastCreatedBox() As MSForms.TextBox
Dim Boxes As Collection
Set Boxes = PullBoxes
With Boxes
If .Count <> 0 Then _
Set LastCreatedBox = Boxes(.Count)
End With
End Function
I think that now things are clearer to you! Cheers!
Note: All code are definitely a bunch of methods/properties of your form, hence all stuff should be placed inside of form module.
Long story short - you cannot do what you want with VBA.
However, there is a good way to go around it - make a boolean formula, that checks whether the object exists, using the On Error. Thus, your code will not be spoiled with it.
Function ControlExists(ControlName As String, FormCheck As Form) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
ControlExists = (Err.Number = 0)
End Function
Taken from here:http://www.tek-tips.com/viewthread.cfm?qid=1029435
To see the whole code working, check it like this:
Option Explicit
Sub TestMe()
Dim i As Long
For i = 1 To 20
If fnBlnExists("Label" & i, UserForm1) Then
Debug.Print UserForm1.Controls(CStr("Label" & i)).Name & " EXISTS"
Else
Debug.Print "Does Not exist!"
End If
Next i
End Sub
Public Function fnBlnExists(ControlName As String, ByRef FormCheck As UserForm) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
fnBlnExists = (Err.Number = 0)
End Function
I would suggest testing the existence in another procedure per below: -
Private Sub Command1_Click()
Dim i As Long
i = 1
Do Until Not BoxExists(i)
If Me.Conrtols("Box" & i).Value = MyCondition Then
'Do stuff
End If
i = i + 1
Next
End Sub
Private Function BoxExists(ByVal LngID As Long) As Boolean
Dim Ctrl As Control
On Error GoTo ErrorHandle
Set Ctrl = Me.Controls("BoX" & LngID)
Set Ctrl = Nothing
BoxExists = True
Exit Function
ErrorHandle:
Err.Clear
End Function
In the above, BoxExists only returns true if the box does exists.
You have taken an incorrect approach here.
If you want to limit the loop, you can loop only in the section your controls reside e.g. Detail. You can use the ControlType property to limit controls to TextBox.
Dim ctl As Control
For Each ctl In Me.Detail.Controls
If ctl.ControlType = acTextBox Then
If ctl.Value = MyCondition Then
'do stuff
End If
End If
Next ctl
I believe the loop will be faster than checking if the control name exists through a helper function and an On Error Resume Next.
But this only a personal opinion.
I had this sub in another spreadsheet where I could click a button to collapse and expand certain columns. I copied it into a new spreadsheet to use to collapse some rows but now I get the error "Sub or function not defined". It highlights Buttons
Sub HideDetails()
Range("3:8").Select
If Selection.EntireColumn.Hidden Then
Selection.EntireColumn.Hidden = False
Buttons("btnToggleDetails").Caption = "-"
Else
Selection.EntireColumn.Hidden = True
Buttons("btnToggleDetails").Caption = "+"
Range("A1").Select
Application.CutCopyMode = False
End If
Range("A1").Select
Application.CutCopyMode = False
End Sub
There are no other scripts in this workbook. This one was originally in Module1 but I tried moving it to a new module.
Edit: I changed the button name in the code but not the screenshot. Both references are to btnToggleDetails now but it still throws the same error.
It's telling you that the identifier Buttons() can't be found in the current scope. If Buttons() is something that you've declared somewhere else, you either need to make it public or you need to fully qualify the object that contains the Buttons() object, for example:
Sheet1.Buttons("btnToggleDetails").Caption = "+"
Had to add my answer as was sure I could shorten the lines of code:
If you consider that Selection.EntireColumn.Hidden returns TRUE/FALSE or 0/-1.
CHR(45) is a minus sign.
CHR(43) is a plus sign.
ABS turns -1 into 1.
So:
If TRUE (0) then 45-(0*2) = 45
If FALSE (-1) then 45-(1*2) = 43
This will swap the columns from hidden to visible and vice-versa and display the correct button caption in the immediate window:
Sub HideShowColumns()
Selection.EntireColumn.Hidden = Not (Selection.EntireColumn.Hidden)
Debug.Print Chr(45 - (Abs(CLng(Selection.EntireColumn.Hidden)) * 2))
End Sub
This should work in your procedure:
Sub HideDetails()
Dim rng As Range
Set rng = ActiveSheet.Range("3:8")
rng.EntireColumn.Hidden = Not (rng.EntireColumn.Hidden)
Buttons("btnToggleDetails").Caption = Chr(45 - (Abs(CLng(rng.EntireColumn.Hidden)) * 2))
End Sub
I have a fair amount of global variables and to keep track of them during debugging I use watches. However it is annoying to add all of them again and again at the beginning of each session. Is there a way to save and load them? Or if that's not possible to add them via code?
This question concerns the watches for expressions in the VBA Editor window (see screenshot).
In a class called WatchedVariables, you could have
Option Explicit
Private str_Variable1_Prev As String
Private str_Variable1 As String
Public Property Let strVariable1(value As String)
str_Variable1_Prev = str_Variable1
str_Variable1 = value
If str_Variable1 <> str_Variable1_Prev Then
Debug.Print "Variable 1 has changed"
Else
End If
End Property
Then you'd access your watched variables, like so clsWatchedVariables.strVariable1="nathan"
However, this may help Find specific text in VBA watch list
It is not very pretty, but you can use Application.SendKeys to add Watches. I have no idea if the language locale affects the shortcut keys. The below applies to English.
The limitation is you can only use things like Current Module or All Modules (i.e. scroll all the way up or all the way down), but not a specific other module for scope. You could probably fix this limitation by using the VBIDE to find out how many modules there are etc, and therefore how many times to scroll up for a particular module. I have not done this for the code below as this is a proof of concept - I leave the fun part to you :-)
Usage: call AddWatch sub with the specified arguments. You can add these to a sub you call when you start a new session, as demonstrated in my "HelloNewSession()"
The VBE must be in focus when the code is run. You can either do this manually or use the VBIDE object to set the focus.
Option Explicit
Enum enumWatchType
WatchExpression
BreakWhenTrue
BreakWhenChange
End Enum
Enum enumProceduresType
AllProcedures
Caller
End Enum
Enum enumModuleType
AllModules
CurrentModule
ThisWorkbook
End Enum
Public testVar As Boolean
Sub HelloNewSession()
AddWatch "testVar = True", AllProcedures, CurrentModule, BreakWhenTrue
testVar = True
End Sub
Sub AddWatch( _
expression As String, _
Optional proceduresType As enumProceduresType = enumProceduresType.Caller, _
Optional moduleType As enumModuleType = enumModuleType.CurrentModule, _
Optional watchType As enumWatchType = enumWatchType.WatchExpression)
Dim i As Long
Application.SendKeys "%DA"
Application.SendKeys getEscapedSendkeysText(expression)
If proceduresType = enumProceduresType.AllProcedures Then
Application.SendKeys "%p"
For i = 1 To 1000 'You could use VBIDE to count the valid types to actually scroll up the right number of times!
Application.SendKeys "{UP}"
Next
End If
If moduleType = enumModuleType.AllModules Then
Application.SendKeys "%m"
For i = 1 To 1000 'You could use VBIDE to count the valid types to actually scroll up the right number of times!
Application.SendKeys "{UP}"
Next
ElseIf moduleType = enumModuleType.ThisWorkbook Then
Application.SendKeys "%m"
For i = 1 To 1000 'You could use VBIDE to count the valid types to actually scroll up the right number of times!
Application.SendKeys "{DOWN}"
Next
End If
Select Case watchType
Case enumWatchType.WatchExpression
Application.SendKeys "%w"
Case enumWatchType.BreakWhenTrue
Application.SendKeys "%t"
Case enumWatchType.BreakWhenChange
Application.SendKeys "%c"
End Select
Application.SendKeys "~"
End Sub
Function getEscapedSendkeysText(ByVal text As String) As String
Dim char As String, i As Long
Const chars As String = "~%+^()[]"
For i = 1 To Len(chars)
char = Mid$(chars, i, 1)
text = Replace(text, char, "{" & char & "}")
Next
getEscapedSendkeysText = text
End Function
I am building a template/form in excel that will be used by different people on different computers to fill in some information and then send it by email to me.
When the template is being filled I need to assign an unique ID number to a field along with other info(kind of like a request ID). I am generating this unique ID by using
CONCATENATE("NER-";DEC2HEX(RANDBETWEEN(0;4294967295);8))
This formula serves me good for the task at hand.
My challenge is to evaluate this formula only one time in the template and then keep it the same when I open the file once it gets to me. Something along the lines of a time stamp. I have already looked into some methods but I cannot seem to get it to work.
I have tried making use of:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
But I do not know how to integrate my concatenate function into the code. I am also not extremely sure if this will keep my unique value untouched when I open the template on my computer.
I would guess that a method that would limit my iterations in the entire sheet would also serve me good.
You could generate and store the ID right when the user first opens the workbook/template, placing this code in the ' ThisWorbook module:
Private Sub Workbook_Open()
'ID already set?
If Sheet1.Range("A2").Value <> "" Then Exit Sub
'Prevent that ID is generated on your machine
If Environ$("Username") = "YOURUSERNAME" Then Exit Sub
'Store ID
Sheet1.Range("A2").Value = _
"NER-" & [DEC2HEX(RANDBETWEEN(0,4294967295),8)]
End Sub
I have the next excel sheet with many checkboxs.
The problem is when I am coding I have to do some functions with Valor1 and Valor2 depending of if the checkbox is activate.
Well I have the code.
Option Explicit
Sub Casilladeverificación1_Haga_clic_en()
Range("c12").Activate
Do
If CheckBox1.Value Then
Call fucntion1
'Works for the first row, but for the second row int shoul be check CheckBox12 ,a next CheckBox23 ...
If CheckBox2.Value Then
Call fucntion1
If CheckBox2.Value Then
Call fucntion3
....
ActiveCell.Offset(1, 0).Activate
While Not IsEmpty(ActiveCell.Value2)
End Sub
But you can notice I dont want to made all the case with all the checkbox, there is a solve for this like checkbox[i]
I would put all of your functions into one big function and the functionality would separated by a Select Case block.
Private Sub functionRouter(checkAction as integer)
Select Case checkAction
Case 1
'Code for function one
Case 2
'Code for function two
''Etc.
End Select
End Sub
You're going to want to loop over all your check boxes. This is going to depend on what checkbox you are using.
Sub test()
Dim chkBox As CheckBox
Dim chkBox2 As OLEObject
'Regular
For Each chkBox In Sheets("Sheet1").CheckBoxes
Debug.Print chkBox.Caption
Next chkBox
'ActiveX
For Each chkBox2 In Sheets("Sheet1").OLEObjects
If TypeName(chkBox2.Object) = "CheckBox" Then
Debug.Print chkBox2.Object.Value
End If
Next chkBox2
You could do a few different things with all of your checkboxes. You could use the tagproperty (you would need to set all of them, but this allows for duplicates). Then call functionRouter(chkBox.tag) Or you could parse something from the name functionRouter Right(chkBox.name, 1)
You can iterate checkboxes on worksheet by using this loop:
For Each chk In ActiveSheet.CheckBoxes
MsgBox chk.Name
Next
It won't work if you use ActiveX controls though.