Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 9 years ago.
Improve this question
In my program l am using timers to make pictureboxes visible and after certain time l make them not visible by using picturebox(1-9).visible = true/false.
Finally l have to count how many pictureboxes are visible at any given time.
l can't figure it out l have tried adding them to a variable but the timer does it over and over every second. l have literally no idea how to do it
This code is for Images on a worksheet, but can easily be modified for wherever your pictureboxes are:
'Count the visible number before starting.
Dim NumberVisible As Integer
NumberVisible = 0
For i = 1 To 9
If myWorkSheet.Shapes(i).Visible = msoTrue Then
NumberVisible = NumberVisible + 1
End If
Next
'....
'Start timer, do timer code here.
'....
myWorkSheet.Shapes(i).Visible = msoTrue
NumberVisible = NumberVisible + 1
'...
myWorkSheet.Shapes(i).Visible = msoFalse
NumberVisible = NumberVisible - 1
You need to check picturebox(1-9).visible itself. The same variable can be set and can also be checked for a given value.
Just loop through all the picture boxes in the form and check their visible property.
Sub foo()
Dim ct As Control
Dim sum As Integer
sum = 0
For Each ct In Me.Controls
If TypeName(ct) = "Image" Then
If ct.Visible = False Then
sum = sum + 1
End If
End If
Next
MsgBox sum
End Sub
Related
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed last year.
Improve this question
I have some .doc files with a lot of text, and I want to change the color of the text each 217 characters. The first 217 characters (including blank spaces) would be one color, the next 217 would be another color and so on.
BUT, I also wanted to create a condition where: If the 217 characters don't end with a period, then the selection must be reduced to the last period before 217.
For example: "The car is blue. We need to go to the". In this case, the sentence: "We need to go to the" would not be selected, because it doesn't end with a period, so the selection would be "the car is blue.", because it does end with a period.
I don't know how can I do this in Word, I'm new to VBA and I don't know if it's possible because I'm used to Excel. Can someone help me?
This code will alternate highlighting yellow and green according to your rules. It may not be perfect, but it will get you started.
Public Sub HighlightText()
Dim lStart As Long, lEnd As Long
Dim r As Range
Dim lColor As Long
lStart = 0
lEnd = 217
lColor = wdBrightGreen
Set r = ThisDocument.Range(lStart, lEnd)
Do Until lEnd > ThisDocument.Range.Characters.Count
'find the last period
r.Find.Execute FindText:=".", Forward:=False
'if found, record where it is
If r.Find.Found Then
lEnd = r.End
Else
Exit Do
End If
'highlight the range
ThisDocument.Range(lStart, lEnd).HighlightColorIndex = lColor
'set up for the next section
lStart = lEnd
lEnd = lEnd + 217
'if you're not at the end, reset r
If lEnd <= ThisDocument.Range.Characters.Count Then
Set r = ThisDocument.Range(lStart, lEnd)
End If
'alternate colors
If lColor = wdBrightGreen Then lColor = wdYellow Else lColor = wdBrightGreen
Loop
ThisDocument.Range(lStart, ThisDocument.Range.Characters.Count).HighlightColorIndex = lColor
End Sub
I have a list of strings that hold 10 answers.
Each question has a different amount of answers 2-10.
After randomizing the list, I end up with white space or empty spaces in my list depending on the number of answers.
After randomizing the list of let's say 2 answers, i would like to shift them back to position 0 and 1 in my list keeping the size of the list at 10 and of course keeping the order randomized.
I'm not sure how to programmatically solve this problem...
I've tried to sort/reverse the list after randomize, but of course, this removes the randomization.
I've tried to remove the white space with something like
answerlist.RemoveAll(Function(str) String.IsNullOrWhiteSpace(str))
but I then get an out of bounds when trying to write them back to my radiobuttons.text as there are 10 of them.
This is where writing my list of...
RadioAnswer1.Text = answerlist(0)
RadioAnswer2.Text = answerlist(1)
RadioAnswer3.Text = answerlist(2)
RadioAnswer4.Text = answerlist(3)
RadioAnswer5.Text = answerlist(4)
RadioAnswer6.Text = answerlist(5)
RadioAnswer7.Text = answerlist(6)
RadioAnswer8.Text = answerlist(7)
RadioAnswer9.Text = answerlist(8)
RadioAnswer10.Text = answerlist(9)
Ideally, I want the list randomized then however many answers there are written back into the list starting at 0 going down to 10.
I hope my question is clear.
Additional info edit
So here is how I'm loading the answers into the List Of..
Dim answerlist As New List(Of String)
WEFESQLConn.ConnectionString = connectstring
WEFESQLConn.Open()
WERESQLStatment.CommandText = "SELECT * FROM [WEFE Questions] WHERE QuestionID = " & SQLQuestionNum.ToString
WERESQLStatment.Connection = WEFESQLConn
WEFESQLRead = WERESQLStatment.ExecuteReader
If WEFESQLRead.HasRows Then
WEFESQLRead.Read()
lblQuestion.Text = WEFESQLRead.Item("Question").ToString
answerlist.Add(WEFESQLRead.Item("CorrectAnswer").ToString)
answerlist.Add(WEFESQLRead.Item("Answer2").ToString)
answerlist.Add(WEFESQLRead.Item("Answer3").ToString)
answerlist.Add(WEFESQLRead.Item("Answer4").ToString)
answerlist.Add(WEFESQLRead.Item("Answer5").ToString)
answerlist.Add(WEFESQLRead.Item("Answer6").ToString)
answerlist.Add(WEFESQLRead.Item("Answer7").ToString)
answerlist.Add(WEFESQLRead.Item("Answer8").ToString)
answerlist.Add(WEFESQLRead.Item("Answer9").ToString)
answerlist.Add(WEFESQLRead.Item("Answer10").ToString)
answerlist.RemoveAll(Function(str) String.IsNullOrWhiteSpace(str))
WEFESQLRead.Close()
WEFESQLConn.Close()
RadioAnswer1.Text = answerlist(0)
RadioAnswer2.Text = answerlist(1)
RadioAnswer3.Text = answerlist(2)
RadioAnswer4.Text = answerlist(3)
RadioAnswer5.Text = answerlist(4)
RadioAnswer6.Text = answerlist(5)
RadioAnswer7.Text = answerlist(6)
RadioAnswer8.Text = answerlist(7)
RadioAnswer9.Text = answerlist(8)
RadioAnswer10.Text = answerlist(9)
With this code I get the out of bounds as there are not enough answers to populate the answerlist.
Without
answerlist.RemoveAll(Function(str) String.IsNullOrWhiteSpace(str))
I get the spaces in my pre-drawn radio buttons.
I am all ready hiding the unused buttons - the issue there are 10 positions for the buttons and with the randomization of the list.
4 spots of 10 used image
Why don't you toggle the visibility of the controls dynamically after removing the blank entries from the list? Take a look at this example:
'Store all controls in a collection
Dim answers(9) As RadioButton = {RadioAnswer1, RadioAnswer2, RadioAnswer3, RadioAnswer4, RadioAnswer5, RadioAnswer6, RadioAnswer7, RadioAnswer8, RadioAnswer9, RadioAnswer10}
'Iterate through all answers
For index As Integer = 0 To answerlist.Count - 1
'Show the control and set the text
With answers(index)
.Text = answerlist.Item(index)
.Visible = True
End With
Next
'Loop through the rest of the answer controls
For index As Integer = answerlist.Count To answers.Length - 1
'Hide the control
answers(index).Visible = False
Next
Initial setup...
Dim radioButtons As New List(Of RadioButton)
radioButtons.Add(RadioAnswer1)
radioButtons.Add(RadioAnswer2)
...
radioButtons.Add(RadioAnswer10)
After removing blank answers from the randomized list...
For i = 0 To answerList.Count - 1
radioButtons(i).Text = answerList(i)
radioButtons(i).Visible = True
Next
For i = answerList.Count to radioButtons.Count - 1
radioButtons(i).Visible = False
Next
To close this out I ended up going with removing all the spaces from my ListOF then using a DO WHILE for each radiobutton.text entries.
example portion
answerlist = RandomizeListOrder(answerlist)
answerlist.RemoveAll(Function(str) String.IsNullOrWhiteSpace(str))
Dim ALCount As Integer = answerlist.Count
Dim ALCounter = 0
Do
If ALCounter < ALCount Then
ALCounter += 1
RadioAnswer1.Text = answerlist(0)
ElseIf ALCounter = ALCount Then
Exit Do
End If
Maybe not very clean as there are 10 of these entries, but I'll work on that later. Just trying to get the idea out.
Thanks everyone for the suggestions they got me on the right path.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
Basically, I have list of credits in a spreadsheet. Each credit heading on the sheet is displayed as Credit(5) and it displays below that 5 credits i.e:
Credit(5)
Cre1
Cre2
Cre3
Cre4
Cre5
Then I have another heading with Credit(3) and that displays 3 credits below it i.e:
Credit(3)
Cre1
Cre2
Cre3
Now my question is how to do this in VB and relay on the numbers (3) and (5) and display below the heading list according to the number in the heading? so in other words have 5 columns below the heading if heading has (5) and 3 for the other one.
Something like this? Credit to paxdiablo here. Edited.
Private Sub CommandButton1_Click()
Dim sTitle As String
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As Integer
Dim i As Integer
Dim k As Integer
For k = 1 To 50
sTitle = Worksheets("Sheet1").Cells(1, k)
If sTitle <> "" Then
openPos = InStr(sTitle, "(")
closePos = InStr(sTitle, ")")
midBit = Mid(sTitle, openPos + 1, closePos - openPos - 1)
For i = 1 To midBit
Worksheets("Sheet1").Cells(i + 1, k) = "cre" & i
Next i
End If
Next k
End Sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
I have an array of 6 digit numbers in which I need to find numbers with same digits but with different order. How can I do this in vba?
I feel a good way to do this would be to take your 6 digit number, create an array containing those 6 digits, sort them, then give you the new number (returned as a string in this example) then compare the two to make sure they are equal.
Public Function SortNumber(intIn As Long)
Dim intArr(1 To 6) As Integer, strResult As String
Dim i As Integer
For i = 1 To 6
intArr(i) = Mid(CStr(intIn), i, 1)
Next i
BubbleSort intArr
For i = 1 To 6
strResult = strResult + CStr(intArr(i))
Next i
SortNumber = strResult
End Function
Function BubbleSort(TempArray As Variant)
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer
Do
NoExchanges = True
For i = 1 To UBound(TempArray) - 1
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Function
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 8 years ago.
Improve this question
I have an array of 6 elements , and I want to fill 18 textboxes with those members randomly each time . I want only to repeat the item 2 times . I have this code :
FlatTextBox1.Text = (subjects.Item(Int(Rnd() * (subjects.Count - 1))))
FlatTextBox2.Text = (subjects.Item(Int(Rnd() * (subjects.Count - 1))))
.
.
.
.
.
.
That continues till the end . Now the problem is that some items get's repeated 3 times and others 1 time so there's no equality . How can I fix this problem ?
Assuming you made a typo and wanted the items repeated 3 times, instead of 2, since 3*6=18:
Public Class Form1
Private R As New Random
Private subjects() As String = {"cat", "dog", "fish", "hamster", "lizard", "bird"}
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim values As New List(Of String)
values.AddRange(subjects)
values.AddRange(subjects)
values.AddRange(subjects)
Dim index As Integer
Dim matches() As Control
For i As Integer = 1 To 18
index = R.Next(values.Count)
matches = Me.Controls.Find("FlatTextBox" & i, True)
matches(0).Text = values(index)
values.RemoveAt(index)
Next
End Sub
End Class