The below behaves quite strangely.
It's aim is to leave the slicer with only the item specified (in this case "Smith") with all other names not selected.
Most of the time it works but sometimes more than one item will be left selected.
What is wrong with the below and how do I achieve the required behaviour?
Sub myRoutine()
unselectAllBut "Slicer_InitialAcc_Surname", "me"
End Sub
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim si As Object
For Each si In ActiveWorkbook.SlicerCaches(slicerName).SlicerItems
si.Selected = (si.Caption = newSelection)
Next si
End Sub
Second attempt which doesn't work either:
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
Maybe the data is causing the problem. It looks like the following:
EDIT
The following seems to work. I select all items first which seems like over-kill:
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = True
Next i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
A bit faster way:
first set the new selection
second clear all others
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Caption = newSelection Then .SlicerItems(i).Selected = True: Exit For
Next i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> newSelection Then .SlicerItems(i).Selected = False
Next i
End With
End Sub
Related
Sorry but I'm a total newbie in CATScript.
But I'm looking for a solution that will provide me to check every node in my Product structure recursively.
I try to adopt the Fibonacci procedure:
Function Fib(n As Long) As Long
Dim first As Long
Dim second As Long
Dim sum As Long
Dim i As Long
first = 0
second = 1
sum = 0
If n = 0 Then
Fib = first
ElseIf n = 1 Then
Fib = second
Else
For i = 2 To n
sum = first + second
first = second
second = sum
Next i
Fib = sum
End If
End Function
with this:
Private Sub TestMain
Dim searchName As String
searchName = "SearchName"
' Start with the selected object
Dim doc As Document
Set doc = CATIA.ActiveDocument
Dim prod As Product
Set prod = doc.Product
Dim foundItem As Object
foundItem = TestMainChildren(doc.Selection.Item(1).Value, searchName)
MsgBox "Found: " & foundItem.Name
End Sub
Private Function TestMainChildren(ByRef catiaObject As Object, ByVal searchName As String) As Object
Dim item As Object
For Each item In catiaObject.Items
If item.Name = "SearchName" then
Set TestMainChildren = item
Exit For
End if
Dim catiaType As String
catiaType = TypeName(item)
If catiaType = "Product" Then
TestMainChildren item, searchName
End If
Next
End Sub
but I have no idea how to do this. Can anybody help here?
It depends on what you want, but it is often very useless to check all the instances whith a recursive loop.
what is your end goal?
i suggest you to check every instance opened :
Sub main()
Dim d As Document
For Each d In CATIA.Documents
Dim p As Product
Set p = d.Product
MsgBox (p.Name)
Next
End Sub
If you insist and really want a recursive loop :
Sub main()
Dim d As Document
Set d = CATIA.ActiveDocument
Dim p As Product
Set p = d.Product
Call RecursiveAllProducts(p) 'here your recursive starts
End Sub
Sub RecursiveAllProducts(p As Product) 'your recursive
MsgBox (p.PartNumber)
If p.Products.Count > 0 Then
For i = 1 To p.Products.Count
Dim p_ As Product
Set p_ = p.Products.Item(i)
Call RecursiveAllProducts(p_) 'you call your recursive again
Next i
End If
End Sub
Module Module1
Dim MenuList As New List(Of String)
Function LineCount() As Integer
Return MenuList.Count
End Function
Sub CreateNewMenu(strings() As String)
For Each s In strings
MenuList.Add(s)
Next
End Sub
Sub PrintMenu(highlight As Integer)
For I = 0 To MenuList.Count - 1
If I = highlight Then
SwapColors()
Console.WriteLine(MenuList(I))
Console.ResetColor()
Else
Console.WriteLine(MenuList(I))
End If
Next
End Sub
Sub SwapColors()
Dim temp = Console.BackgroundColor
Console.BackgroundColor = Console.ForegroundColor
Console.ForegroundColor = temp
End Sub
Sub Main()
CreateNewMenu(
{
"Option A",
"Option B",
"Option C"
})
Dim CurrentItem As Integer = 0
Dim CurrentKey As ConsoleKey
While CurrentKey <> ConsoleKey.Enter
Console.Clear()
PrintMenu(CurrentItem)
'Console.SetCursorPosition(10, 10)
'Console.SetCursorPosition(10, 11)
'Console.SetCursorPosition(10, 12)
CurrentKey = Console.ReadKey(True).Key
Select Case CurrentKey
Case ConsoleKey.DownArrow
CurrentItem += 1
Case ConsoleKey.UpArrow
CurrentItem -= 1
End Select
CurrentItem = (CurrentItem + LineCount()) Mod LineCount()
End While
End Sub
End Module
This is a Code, A changed Post written 2014. The following link should be the source. How can you detect key presses in vb console mode?
The PrintMenu Procedure spotted in the Main Sub Procedure is the line i try to Change with a SetCursorPosition command.
I am able to Change the Output to be screened on row 10 line 10. But only for the Option A.
What has to be done, to manage every item that can be listed on Screen? I want to change the row and line for every item through the PrintMenu Procedure.
The problem is that the cursor position is set for the first item in the list but when WriteLine is called, the cursor position is reset to the next line on column = 0. I would change the PrintMenu method to accept the left and top cursor positiion. Something like this (untested):
Sub PrintMenu(highlight As Integer, left As Integer, top As Integer)
For I = 0 To MenuList.Count - 1
Console.CursorLeft = left
Console.CursorTop = top + I 'Use loop variable to adjust top position
If I = highlight Then
SwapColors()
Console.Write(MenuList(I)) 'Changed to use Write instead
Console.ResetColor()
Else
Console.Write(MenuList(I))
End If
Next
End Sub
I'm rewriting some code and had a thought, but can't seem to get my syntax right to execute it properly. I want to use a for loop to populate an array of commandbuttons as well as control their visibility. I just need help with my syntax to define which CommandButton number I'm working on in the loop. For instance, CommandButton1, CommandButton2, etc.
Public Sub LoadLots(sName As String, streamLots() As String)
Label1.Caption = sName
For o = 1 To 9
If streamLots(o) <> "" Then
CommandButton& o &.Caption = streamLots(o)
CommandButton& o & .Visable = True
Else
CommandButton& o & .Visable = False
End If
Next
End Sub
Use the Userform.Controls collection to reference the commandbuttons by name.
Public Sub LoadLots(sName As String, streamLots() As String)
Dim btn As MSForms.CommandButton
Label1.Caption = sName
For o = 1 To 9
Set btn = Me.Controls("CommandButton" & o)
If streamLots(o) <> "" Then
btn.Caption = streamLots(o)
btn.Visible = True
Else
btn.Visible = False
End If
Next
End Sub
Trying to search on a ListBox. Specifically, I want to look at an array of items from the Cell, and for each one that matches an entry in the ListBox, I want it to select that List.
I copy-pasted some code that was supposed to let me find a string, but it keeps telling me:
Compile Error: Method or Data Member not found.
Any suggestions?
Relevant Code:
Public local_Target As Range
' local_Target is assigned in the sheet function to pass it here
Private Sub Network_ListBox_Enter()
' Get data in cell (if any)
Dim current_data As String
Dim entries() As String
current_data = local_Target.Value
If current_data = "" Then
Exit Sub
Else
entries = Split(current_data, vbNewLine)
End If
For Each Item In entries
FindMyString Item
Next Item
End Sub
Private Sub UserForm_Terminate()
Dim index As Integer
Dim result As String
' Iterate through the listbox and create the result, then assign to
' Target.value
For index = 0 To Network_ListBox.ListCount - 1
If Network_ListBox.Selected(index) Then
' stuff
If result = "" Then
result = Network_ListBox.List(index)
' ElseIf index = Network_ListBox.ListCount - 1 Then
' result = result + Network_ListBox.List(index)
Else
result = result + vbNewLine + Network_ListBox.List(index)
End If
End If
Next index
local_Target.Value = result
End Sub
Sub FindMyString(ByVal searchString As String)
' Ensure we have a proper string to search for.
If searchString <> "" Then
' Find the item in the list and store the index to the item.
Dim index As Integer
index = Me.Network_ListBox.FindString(searchString)
' Determine if a valid index is returned. Select the item if it is valid.
If index <> -1 Then
Network_ListBox.SetSelected index, True
'Else
' MessageBox.Show ("The search string did not match any items in the ListBox")
End If
End If
End Sub
I checked Intellisense and I don't think that Method is supported in VBA. Other documentations I've found refers to .Net Framework only as well. So maybe, it is not really supported in VBA, but regardless, you can create a function to do just that. Something like below.
Private Function SearchString(mysearch As String, mylist As Variant) As Long
Dim itm As Variant, idx As Long: idx = 0
If IsArray(mylist) Then
For Each itm In mylist
If mysearch = itm Then
SearchString = idx: Exit Function
End If
idx = idx + 1
Next
End If
SearchString = -1
End Function
And you can use it like this:
Private Sub CommandButton1_Click()
Dim i As Long
'do the search
i = SearchString("WhatImSearching", Me.ListBox1.List)
'select the item that match your search
If i <> -1 Then Me.ListBox1.Selected(i) = True
End Sub
I'm not saying that the function I created above is the most efficient way.
That is just an example to give you an idea for a workaround. HTH.
Important: This works in single column ListBox which have a 1D array list. If you need to work on multi-column ListBox, you'll have to tweak the function a little.
I have the following code:
If moves.Contains("1") Then
lblOnes.Visible = True
End If
If moves.Contains("2") Then
lblTwos.Visible = True
End If
If moves.Contains("3") Then
lblThrees.Visible = True
End If
If moves.Contains("4") Then
lblFours.Visible = True
End If
If moves.Contains("5") Then
lblFives.Visible = True
End If
If moves.Contains("6") Then
lblSixes.Visible = True
End If
I just feel like it is redundant, is there any way to do this without repeating the same statement over and over?
You could e.g. use a look up using a Dictionary:
Dim map = new Dictionary(Of String, Label) From
{
{"2", lblTwos},
{"3", lblThrees},
{"4", lblFours},
{"5", lblFives},
{"6", lblSixes}
}
For Each kvp In map
If moves.Contains(kvp.Key) Then
kvp.value.Visible = True
End If
Next
Other possible ways:
use the Tag property of the controls
name your controls lbl_1, lbl_2 etc. and loop over all elements in moves to find the right control by its name.
Another example:
Dim lbls() As Label = {lblOnes, lblTwos, lblThrees, lblFours, lblFives, lblSixes}
For i As Integer = 0 To lbls.Length - 1
If moves.Contains((i + 1).ToString) Then
lbls(i).Visible = True
Else
' ... possibly do something in here? ...
End If
Next
If you have the luxury of renaming your Labels from lblOnes, lblTwos etc. to lbl1s, lbl2s, then it would simply be:
For i = 1 To 6
Me.Controls("lbl" & i & "s").Visible = moves.Contains(i.ToString())
Next
I propose following idea:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim moves As String
moves = "1"
Dim controlName As String
controlName = "lbl" + moves
CType(Me.Controls("controlName"), Label).Visible = True
End Sub