I have a TreeView in excel 2007 with checkboxes.
I want the checkboxes to be all selected when the tree is populated
I want that when I select/unselect a parent node of the list, all its children are selected/unselected
Here is the code I have written so far:
Private Sub UserForm_Initialize()
'Set control defaults
With Me
.CommandButton1.Caption = "Close"
.Label1 = vbNullString
.ZonesTree.LineStyle = tvwRootLines
End With
'Populate the Treeview
Call TreeView_Populate
End Sub
Private Sub TreeView_Populate()
Dim wbBook As Workbook
Dim wsZones As Worksheet
Dim rngZones As Range
Dim rngCinemas As Range
Dim lngRows As Long
Set wbBook = ThisWorkbook
Set wsZones = wbBook.Worksheets("Cinemas")
'lngRows = wsZones.Range("A65536").End(xlUp).row
lngRows = wsZones.UsedRange.Rows.Count
Set rngZones = wsZones.Range("A1:A" & lngRows)
Dim rngBC As Range
Set rngBC = wsZones.Range("B1:C" & lngRows)
Dim rCell As Range
Dim lastCreatedKey As String
Dim rowCount As Integer
Dim currentRowRange As Range
rowCount = 1
lastCreatedKey = ""
With Me.ZonesTree.Nodes
'Clear TreeView control
.Clear
For Each rCell In rngZones
If Not rCell.Text = "" Then
.Add Key:=rCell.Text, Text:=rCell.Text
lastCreatedKey = rCell.Text
Else
Set currentRowRange = rngBC.Rows(rowCount)
.Add Relative:=lastCreatedKey, relationship:=tvwChild, Key:=currentRowRange.Cells(, 2).Text, Text:=currentRowRange.Cells(, 1).Text
End If
rowCount = rowCount + 1
Next rCell
End With
End Sub
Private Sub Treeview1_NodeClick(ByVal Node As MSComctlLib.Node)
Me.Label1.Caption = Node.Key
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
This tree picks data from a sheet in this manner:
---A---------B---------C---------D
ParentNode
------------ChildNode
------------ChildNode
------------ChildNode
ParentNode
------------ChildNode
------------ChildNode
ParentNode
------------ChildNode
etc... (you get the idea, its an excel sheet...)
What is the vba code to select/unselect the boxes?? I have been searching a lot and couldn't find an answer to this easy problem....
Thx in advance!
On access which I assume uses the same control the property you use is .checked
Just set that to true for the boxes you want ticked
Here is a code sample
Set iNode = objTree.Nodes.Add(strParent,tvwChild, strKey, strText)
iNode.Checked = true
You should be to adapt it to work in excel
Related
I have a code which I would like to use on multiple sheets, except one sheet. But applying the code to alle sheets is also fine.
Here is the code that I would like to adjust. I am have currently applied it to Excel 2011 in OS X , but I would like to use it for Excel 2010 in Windows.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = Sheet1.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = Sheet1.Range(the_column & "1")
If the_selection = month_in_review Then
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
Sheet1.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
End Sub
In the module I have the following code:
Public Function GetColumnLetter_ByInteger(what_number As Integer) As String
GetColumnLetter_ByInteger = ""
MyColumn_Integer = what_number
If MyColumn_Ineger <= 26 Then
column_letter = ChrW(64 + MyColumn_Integer)
End If
If MyColumn_Integer > 26 Then
column_letter = ChrW(Int((MyColumn_Integer - 1) / 26) + 64) & ChrW(((MyColumn_Integer - 1) Mod 26) + 65)
End If
GetColumnLetter_ByInteger = column_letter
End Function
If you're asking for one sheet to detect the change in cell "A1" and then to hide/unhide columns on multiple sheets then the prior answers to your question will serve you nicely.
If, on the other hand, you're asking to detect a change in cell "A1" on any sheet and then to hide/unhide columns on just the changed sheet, then the code below will work for you. It accesses the Workbook_SheetChanged event at Workbook level.
A few points about your code:
You can reference cells using their integer or address values with the .Cell property, so Sheet1.Cells(1, 1) is the same as Sheet1.Cells(1, "A"). The same applies to the .Columns property. So there's no real need to convert your integer values to a string. See #Florent B's answer for a good example of this.
Wherever possible, minimise looping sheet interactions as these are very time-consuming. So rather than loop through the columns and hide/unhide each one individually, you could assign them to ranges within your loop and then hide/unhide the ranges all in one go at the end of your loop. If you must interact with the sheet on each iteration of your loop, then set the Application.ScreenUpdating property to false before the start of your loop. There's an example of this property in the sample code below.
Put this in your Workbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const TARGET_ADDRESS As String = "A1"
Dim cell As Range
Dim hiddenCols As Range
Dim unhiddenCols As Range
Dim selectedMonth As String
Dim monthInReview As String
Dim c As Integer
'Ignore event if not a target worksheet
If Sh.Name = "Not Wanted" Then Exit Sub
'Ignore event if not in target range
Set cell = Target.Cells(1)
If cell.Address(False, False) <> TARGET_ADDRESS Then Exit Sub
'Criteria met, so handle event
selectedMonth = CStr(cell.Value)
For c = 2 To 379
Set cell = Sh.Cells(1, c)
monthInReview = CStr(cell.Value)
'Add cell to hidden or unhidden ranges
If monthInReview = selectedMonth Then
If unhiddenCols Is Nothing Then
Set unhiddenCols = cell
Else
Set unhiddenCols = Union(unhiddenCols, cell)
End If
Else
If hiddenCols Is Nothing Then
Set hiddenCols = cell
Else
Set hiddenCols = Union(hiddenCols, cell)
End If
End If
Next
'Hide and unhide the cells
Application.ScreenUpdating = False 'not really needed here but given as example
If Not unhiddenCols Is Nothing Then
unhiddenCols.EntireColumn.Hidden = False
End If
If Not hiddenCols Is Nothing Then
hiddenCols.EntireColumn.Hidden = True
End If
Application.ScreenUpdating = True
End Sub
You can use a for each loop to loop through all the Worksheets, and check the worksheet name if it should be skipped. Then apply your code onto the sheet selected.
Something like:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Skip Sheet" Then
Dim the_selection As String
Dim month_in_review As String
the_selection = ws.Range("A1")
Dim Rep As Integer
For Rep = 2 To 379
the_column = GetColumnLetter_ByInteger(Rep)
month_in_review = ws.Range(the_column & "1")
If the_selection = month_in_review Then
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = False
Else
ws.Range(the_column & ":" & the_column).EntireColumn.Hidden = True
End If
Next Rep
End If
Next ws
End If
End Sub
I wasn't entirely sure what you wished to achieve, so i put ws in the place of Sheet1.
This example will show/hide the columns in all the other sheets if the first cell of the column match/differ with the cell A1 of the sheet where this code is placed:
Private Sub Worksheet_Change(ByVal Target As Range)
' exit if not cell A1
If Target.row <> 1 Or Target.column <> 1 Then Exit Sub
Dim sheet As Worksheet
Dim the_selection As String
Dim month_in_review As String
Dim column As Integer
the_selection = Target.Value
' iterate all the sheets
For Each sheet In ThisWorkbook.Worksheets
' skip this sheet
If Not sheet Is Me Then
' iterate the columns
For column = 2 To 379
' get the first cell of the column
month_in_review = sheet.Cells(1, column).Value
' hide or show the column if it's a match or not
sheet.Columns(column).Hidden = month_in_review <> the_selection
Next
End If
Next
End Sub
This sub removes all command buttons and their associated rows that were created programmatically on a sheet. It takes around 20 seconds to remove 60 command buttons and rows. I've stepped through it and can find no problems with it.
Sub ResetForm_Click()
Dim Contr
Dim controlname As String
Dim WS As Worksheet
Set WS = ActiveSheet
For Each Contr In WS.OLEObjects
controlname = Mid(Contr.Name, 1, 2)
If controlname = "CB" Then
Contr.TopLeftCell.Rows.EntireRow.Delete
Contr.Delete
End If
Next
End Sub
Instead of deleting rows one-by-one try something like this (untested):
Sub ResetForm_Click()
Dim Contr
Dim controlname As String
Dim WS As Worksheet, rDel As Range
Set WS = ActiveSheet
For Each Contr In WS.OLEObjects
controlname = Mid(Contr.Name, 1, 2)
If controlname = "CB" Then
If rDel Is Nothing then
Set rDel = Contr.TopLeftCell
Else
Set rDel = Application.Union(rDel, Contr.TopLeftCell)
End If
Contr.Delete
End If
Next
If Not rDel Is Nothing then rDel.EntireRow.Delete
End Sub
Without editing your macro too much, turn off screen updating and autocalculation, see if that helps.
At the beginning of your macro (I usually put it after my declarations), add
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Then at the end (before End Sub), turn them back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
I have a treeview control on the form which looks like:
I want to iterate the treeview and write the contents of the treeview to ini file. So the ini file for the given tree would look like:
[EnvironmentSystem]
UpdateRate=50.0
InclinationAngle=20.7
Latitude=34.0
[Reflection]
NumReflectionLevel=5
NumSunLightLevel=5
NumWeatherLevel=3
TextureNameFormat=Reflection%01d%01d%02d.tga
[CloudsClear]
MaxClouds=48
MaxCloudParticles=51
3DCloudMaterial=CloudMaterial
3DCloudHorizontalSize=1400.0
3DCloudVerticalSize=600.0
3DCloudSizeDeviation=0.6
3DCloudParticleDensity=2.4
ParticleSize=300.0
ParticleSizeDeviation=0.3
MinBaseAltitude=400.0
MaxBaseAltitude=2450.0
UseBottomRow=TRUE
Here is the code that I have written:
Private Sub TvSaveToIniBtn_Click()
Dim nodx As Node
Dim i As Long
Dim sectionCount As Integer
sectionCount = TreeView1.Nodes(1).Children
Set nodx = TreeView1.Nodes(1).Child.FirstSibling
For i = 1 To sectionCount
SaveNodesToIni (nodx.Text)
Set nodx = nodx.Next
Next
End Sub
Sub SaveNodesToIni(sName As Variant)
Dim tvn As Node
Set tvn = TreeView1.Nodes(sName)
Dim chil As Integer
Dim a As Integer
Dim ret As Integer
Dim keyValuePair() As String
Dim nElements As Integer
chil = tvn.Children: If chil = 0 Then Exit Sub ' if no children the exit
Set tvn = tvn.Child.FirstSibling
For a = 1 To chil
keyValuePair = Split(tvn.Text, "=")
nElements = UBound(keyValuePair) - LBound(keyValuePair) + 1
If nElements > 0 Then
ret = WritePrivateProfileString(sName, keyValuePair(0), keyValuePair(1), "C:\\MyPrograms\\config.ini")
End If
Set tvn = tvn.Next
Next
End Sub
It is not giving the correct output, it gets stuck at the second section of reflection and is not able to read the third one. Something wrong with the code.
I'm brand new to ArcObjects SDKs and am struggling. I have a Python Add-in performing a query to select records (works great)and now trying to call the identify dialog via an .NET addin button that displays the identify dialog box to show attributes of the selected records. Below is the code I have at this point. I currently have the identify dialog displaying, but no records appearing. I know I need to input the selected records somewhere....but not sure where. Any thoughts would be appreciated. (I'm using Visual Studio/Microsoft Visual Basic 2010 and ArcGIS 10.2.1)
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Public Class Identify_Button
Inherits ESRI.ArcGIS.Desktop.AddIns.Button
Dim pMxDoc As IMxDocument
Dim activeView As IMap
Public Sub DoIdentify(ByVal activeView As ESRI.ArcGIS.Carto.IActiveView, ByVal x As System.Int32, ByVal y As System.Int32)
pMxDoc = My.ArcMap.Application.Document
activeView = pMxDoc.FocusMap
If activeView Is Nothing Then
Return
End If
Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap
Dim identifyDialog As ESRI.ArcGIS.CartoUI.IIdentifyDialog = New ESRI.ArcGIS.CartoUI.IdentifyDialogClass
identifyDialog.Map = map
'Clear the dialog on each mouse click
identifyDialog.ClearLayers()
Dim screenDisplay As ESRI.ArcGIS.Display.IScreenDisplay = activeView.ScreenDisplay
Dim display As ESRI.ArcGIS.Display.IDisplay = screenDisplay ' Implicit Cast
identifyDialog.Display = display
Dim identifyDialogProps As ESRI.ArcGIS.CartoUI.IIdentifyDialogProps = CType(identifyDialog, ESRI.ArcGIS.CartoUI.IIdentifyDialogProps) ' Explicit Cast
Dim enumLayer As ESRI.ArcGIS.Carto.IEnumLayer = identifyDialogProps.Layers
enumLayer.Reset()
Dim layer As ESRI.ArcGIS.Carto.ILayer = enumLayer.Next
Do While Not (layer Is Nothing)
identifyDialog.AddLayerIdentifyPoint(layer, x, y)
layer = enumLayer.Next()
Loop
identifyDialog.Show()
End Sub
Public Sub New()
End Sub
Protected Overrides Sub OnClick()
DoIdentify(activeView, 300, 100)
End Sub
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
End Class
Give the code below a try. This is executed from the OnClick event from an ArcMap command button that Inherits from BaseCommand. It displays the selected features in the map in the identifyDialog just as you were needing it to except I used AddLayerIdentifyOID() instead of AddLayerIdentifyPoint() although both should work.
Public Overrides Sub OnClick()
'VBTest.OnClick implementation
Try
Dim mxDoc As IMxDocument = m_application.Document
Dim map As ESRI.ArcGIS.Carto.IMap = mxDoc.FocusMap
Dim layer As ESRI.ArcGIS.Carto.ILayer
Dim flayer As ESRI.ArcGIS.Carto.IFeatureLayer
Dim featSelection As ESRI.ArcGIS.Carto.MapSelection = map.FeatureSelection
Dim feat As ESRI.ArcGIS.Geodatabase.IFeature = featSelection.Next()
Dim count As Int16 = 0
While feat IsNot Nothing
count += 1 ' flag for clearing layers
flayer = New ESRI.ArcGIS.Carto.FeatureLayer()
flayer.FeatureClass = feat.Class
layer = flayer
DoIdentify(layer, feat.OID, (count = 1))
feat = featSelection.Next()
End While
Catch ex As Exception
' handle error
MsgBox("Error: " + ex.Message)
End Try
End Sub
Private Sub DoIdentify(ByVal layer As ESRI.ArcGIS.Carto.ILayer, ByVal OID As Int32, Optional ByVal clearLayers As Boolean = True)
If layer Is Nothing Or OID <= 0 Then
Return
End If
Dim pMxDoc As IMxDocument = m_application.Document
Dim activeView As ESRI.ArcGIS.Carto.IActiveView = pMxDoc.ActiveView
Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap
Dim identifyDialog As ESRI.ArcGIS.CartoUI.IIdentifyDialog = New ESRI.ArcGIS.CartoUI.IdentifyDialogClass()
Dim screenDisplay As ESRI.ArcGIS.Display.IScreenDisplay = activeView.ScreenDisplay
Dim display As ESRI.ArcGIS.Display.IDisplay = screenDisplay
identifyDialog.Map = map ' REQUIRED
identifyDialog.Display = display ' REQUIRED
' Clear the dialog
If clearLayers Then
identifyDialog.ClearLayers()
End If
' Add our selected feature to the dialog
identifyDialog.AddLayerIdentifyOID(layer, OID)
' Show the dialog
identifyDialog.Show()
End Sub
I am creating a excel sheet that would autocomplete a text based on the text present in a particular column. After trying to make one myself unsuccessfully, I was looking online for sample codes that I could modify and incorporate in my program. (and not plagiarize)
I downloaded Workbook1.xls from http://www.ozgrid.com/forum/showthread.php?t=144438
The code is
Option Explicit
Dim ufEventsDisabled As Boolean
Dim autoCompleteEnabled As Boolean
Dim oRange As Range
Private Sub TextBox1_Change()
If ufEventsDisabled Then Exit Sub
If autoCompleteEnabled Then Call myAutoComplete(TextBox1)
End Sub
Sub myAutoComplete(aTextBox As MSForms.TextBox)
Dim RestOfCompletion As String
On Error GoTo Halt
With aTextBox
If .SelStart + .SelLength = Len(.Text) Then
RestOfCompletion = Mid(oRange.Cells(1, 1).AutoComplete(.Text), Len(.Text) + 1)
ufEventsDisabled = True
.Text = .Text & RestOfCompletion
.SelStart = Len(.Text) - Len(RestOfCompletion)
.SelLength = Len(RestOfCompletion)
End If
End With
Halt:
ufEventsDisabled = False
On Error GoTo 0
End Sub
Private Sub TextBox1_AfterUpdate()
Dim strCompleted As String
With TextBox1
strCompleted = oRange.AutoComplete(.Text)
If LCase(strCompleted) = LCase(.Text) Then
ufEventsDisabled = True
.Text = strCompleted
ufEventsDisabled = False
End If
End With
End Sub
Private Sub TextBox1_Enter()
Set oRange = ThisWorkbook.Sheets("Sheet1").Range("f4")
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
autoCompleteEnabled = KeyCode <> vbKeyBack
autoCompleteEnabled = ((vbKey0 <= KeyCode) And (KeyCode <= vbKeyZ))
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Click()
End Sub
If you'd notice the line RestOfCompletion = Mid(oRange.Cells(1, 1).AutoComplete(.Text), Len(.Text) + 1), I was wondering what AutoComplete is doing here. Its not a in built function and is not defined anywhere. Still the code runs fine. I am very curious.
Thanks
The .AutoComplete is a function of the Range object - it is based on passing the text to a range that exists elsewhere on the sheet.
You can see the documentation on this function here:
http://msdn.microsoft.com/en-us/library/bb209667(v=office.12).aspx
The myAutoComplete function handles the finding of the autocomplete data against the range if it exists, and the other pieces in the code are for highlighting the correct piece of text.