Make a Group Shape appear/disapear based on Input - vba

If the input in "C18" is 1, Group 1/2/3/4 (groups of lines) should disappear. Doesn't happen.
Code:
Private Sub Design_Click()
Dim TorsionGroup As ShapeRange
Dim Toption As Integer
Set Toption = Range("C18")
Set TorsionGroup = Shapes.Range(Array("Group 1", "Group 2", "Group 3", "Group 4"))
If Toption = 1 Then
ActiveSheet.TorsionGroup.GroupItems().Visible = False
Else
ActiveSheet.TorsionGroup.GroupItems().Visible = True
End If
End Sub

Public Sub Design_Click()
Shapes.Range(["Group "&column(a:d)]).Visible = [C18] = 1
End Sub
or if you group the groups into a single group, just:
Public Sub Design_Click()
[Group 5].Visible = [C18] = 1
End Sub

Related

how to memorize and randomize the questions in MCQ?

Dears,
I'm looking for assistance in visual basic with respect to multiple choices questions (MCQ).
by using visual basic for Visual Studio 2015
apply the codes without using database:
1- how to Not make any duplications in the questions?(for memorizing purpose... what is wrong and what is right?) E.g. Assuming I open the program and the first question is the word “rich” ,and I chose the correct answer, which is “IT”, I don’t want to see “rich” again until I finish with the whole list. However, if I make the wrong choice for “rich” for anything else e.g. “HR”, I want the word “rich” to appear after a while until I get the question correct. The point here to make the person memorize “rich” is “IT”.
Please write the codes down in your comment (the point you answering)
sorry for asking long question
Thank you
Public Class Form1
Private Structure questionsNanswers
Public Q As String
Public A As String
Public QT As Integer
Public QC As Integer
End Structure
Private wstart As Integer = 0
Private adad As Integer = 10
Private QA(9999) As questionsNanswers
Private word(15) As String
Private aray(15) As Integer
Private Sub RandomizeArray(a As Integer, ByRef array() As Integer)
Dim i As Integer
Dim j As Integer
Dim tmp As Integer
Randomize()
For i = 0 To a - 1
j = Int((6 - i + 1) * Rnd() + i)
tmp = array(i)
array(i) = array(j)
array(j) = tmp
Next
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
' next
CheckEntry()
wstart = wstart + 1
If wstart >= adad Then
wstart = 0
End If
WriteText()
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
' previous
CheckEntry()
wstart = wstart - 1
If wstart < 0 Then
wstart = adad - 1
End If
WriteText()
End Sub
Private Sub CheckEntry()
RadioButton1.Visible = True
RadioButton2.Visible = True
RadioButton3.Visible = True
RadioButton4.Visible = True
RadioButton1.ForeColor = Color.Black
RadioButton2.ForeColor = Color.Black
RadioButton3.ForeColor = Color.Black
RadioButton4.ForeColor = Color.Black
RadioButton1.Checked = False
RadioButton2.Checked = False
RadioButton3.Checked = False
RadioButton4.Checked = False
End Sub
Private Sub WriteText()
Dim out As Boolean = False
For kk = 0 To 6
aray(kk) = kk
Next
RandomizeArray(7, aray)
Do Until out
For j = 0 To 3
If out = False Then
If aray(j) = QA(wstart).QT Then
out = True
Exit Do
End If
End If
Next
For kkk = 0 To 6
aray(kkk) = kkk
Next
RandomizeArray(7, aray)
Loop
RadioButton1.Text = word(aray(0))
RadioButton2.Text = word(aray(1))
RadioButton3.Text = word(aray(2))
RadioButton4.Text = word(aray(3))
Label1.Text = CStr(wstart + 1) & ") " & QA(wstart).Q
' ==============================
Dim go As Boolean = False
If go Then
Dim msg As String
For ll = 0 To 6
msg = msg + CStr(aray(ll)) + "|"
Next
MsgBox(msg)
End If
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
word(0) = "TA"
word(1) = "GR"
word(2) = "HR"
word(3) = "FIN"
word(4) = "commercial"
word(5) = "Proc"
word(6) = "IT"
QA(0).Q = "rich"
QA(0).A = word(6)
QA(0).QT = 6
QA(0).QC = -1
QA(1).Q = "Tal"
QA(1).A = word(1)
QA(1).QT = 1
QA(1).QC = -1
QA(2).Q = "sau"
QA(2).A = word(2)
QA(2).QT = 2
QA(2).QC = -1
QA(3).Q = "pat"
QA(3).A = word(3)
QA(3).QT = 3
QA(3).QC = -1
QA(4).Q = "del"
QA(4).A = word(5)
QA(4).QT = 5
QA(4).QC = -1
WriteText()
End Sub
End Class
Procedures :
1•Store the questions in a database(E.g. MySql/MSSQL/EXCEL)
2•In the database, create a table of 6 columns(column 1 for questions,column 2 for mcq option1,column 3 for mcq option 2, column 4 for mcq option 3,column 5 for mcq option 4 and finally column 6 for mcq answer )
3•Add 1 label and 4 Radio buttons
Now all you have to do is follow this and use the code..
That'll do the work

Microsoft Word VBA multiple addresses - text box

Apologies in advance if this is already a question.
I've developed a user form to auto populate some of the letters we send to stakeholders. I currently have an address section in the userform - textboxstreet textboxsuburb etc.
User form
in certain circumstances I need to have:
Address A - the address we are sending the letter to
and
Address B - the address we sent the letter to previously
For example:
John Smith
15 Madeup Street
Faketown Australia
this is a follow up letter to advise we have sent your previous letter to 33 Fake Place Nowhere Australia.
My conclusion is that I obviously need an Address A section and an Address B section to break the addresses up. Is there a way though - if address a and address b are the same, that address a populates at the bookmarks set for Address B?
eg:
If address' are different:
(bookmarkaddressA) = textboxaddressA
(bookmarkaddressB) = textboxaddressB
If address' are the same:
(bookmarkaddressA) = textboxaddressA
(bookmarkaddressB) = textboxaddressA
Ideally I would like it to function like the
"is the postal address the same as the residential address?" checkbox - and just grey out/lock textboxaddressb and fill the info from textboxaddressa
Any suggestions welcome.
full code:
Option Explicit
Private Sub CheckBox1_Click()
If (CheckBox1.Value = True) Then TextBoxStreet2 = TextBoxStreet
If (CheckBox1.Value = True) Then TextBoxSuburb2 = TextBoxSuburb
If (CheckBox1.Value = True) Then TextBoxPostcode2 = TextBoxpostcode
If (CheckBox1.Value = True) Then ComboBoxState2 = ComboBoxState
If (CheckBox1.Value = False) Then TextBoxStreet2 = Null
If (CheckBox1.Value = False) Then TextBoxSuburb2 = Null
If (CheckBox1.Value = False) Then TextBoxPostcode2 = Null
If (CheckBox1.Value = False) Then ComboBoxState2 = Null
End Sub
Private Sub ComboBoxTitle_Change()
End Sub
Private Sub CommandButtonCancel_Click()
Unload Me
End Sub
Private Sub CommandButtonClear_Click()
TextBoxFN.Value = Null
TextBoxGN.Value = Null
ComboBoxState.Value = Null
ComboBoxTitle.Value = Null
TextBoxStreet.Value = Null
TextBoxSuburb.Value = Null
TextBoxpostcode.Value = Null
TextBoxCD.Value = Null
TextboxMPN.Value = Null
TextBoxMPDD.Value = Null
TextBoxNPN.Value = Null
TextBoxNPDD.Value = Null
ComboBoxState2.Value = Null
TextBoxStreet2.Value = Null
TextBoxSuburb2.Value = Null
TextBoxPostcode2.Value = Null
CheckBox1.Value = False
End Sub
Private Sub CommandButtonOk_Click()
Application.ScreenUpdating = False
With ActiveDocument
.Bookmarks("Title").Range.Text = ComboBoxTitle.Value
.Bookmarks("GN").Range.Text = TextBoxGN.Value
.Bookmarks("FN").Range.Text = TextBoxFN.Value
.Bookmarks("FN2").Range.Text = TextBoxFN.Value
.Bookmarks("Street").Range.Text = TextBoxStreet.Value
.Bookmarks("Suburb").Range.Text = TextBoxSuburb.Value
.Bookmarks("State").Range.Text = ComboBoxState.Value
.Bookmarks("PostCode").Range.Text = TextBoxpostcode.Value
.Bookmarks("Street2").Range.Text = TextBoxStreet2.Value
.Bookmarks("Suburb2").Range.Text = TextBoxSuburb2.Value
.Bookmarks("State2").Range.Text = ComboBoxState2.Value
.Bookmarks("PostCode2").Range.Text = TextBoxPostcode2.Value
.Bookmarks("CD").Range.Text = TextBoxCD.Value
.Bookmarks("MPN").Range.Text = TextboxMPN.Value
.Bookmarks("MPN2").Range.Text = TextboxMPN.Value
.Bookmarks("MPN3").Range.Text = TextboxMPN.Value
.Bookmarks("MPN4").Range.Text = TextboxMPN.Value
.Bookmarks("MPN5").Range.Text = TextboxMPN.Value
.Bookmarks("MPDD").Range.Text = TextBoxMPDD.Value
.Bookmarks("NPN").Range.Text = TextBoxNPN.Value
.Bookmarks("NPDD").Range.Text = TextBoxNPDD.Value
End With
Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub UserForm_Initialize()
With ComboBoxState
.AddItem "QLD"
.AddItem "NSW"
.AddItem "ACT"
.AddItem "VIC"
.AddItem "TAS"
.AddItem "SA"
.AddItem "WA"
.AddItem "NT"
End With
With ComboBoxTitle
.AddItem "Mr"
.AddItem "Mrs"
.AddItem "Miss"
.AddItem "Ms"
End With
lbl_Exit:
Exit Sub
End Sub
Private Sub TextBoxMPN_Change()
TextboxMPN = UCase(TextboxMPN)
End Sub
Private Sub TextBoxNPN_Change()
TextBoxNPN = UCase(TextBoxNPN)
End Sub
Private Sub TextBoxFN_Change()
TextBoxFN = UCase(TextBoxFN)
End Sub
Since you asked, this is what i might have done (some code not included for clarity):
'disable "address B" controls is user selects to use same address for both
Private Sub CheckBox1_Click()
Dim en As Boolean
en = Not CheckBox1.Value
EnableControls Array(TextBoxStreet2, TextBoxSuburb2, _
ComboBoxState2, TextBoxPostcode2), en
End Sub
'utility sub: enable/disable controls
Private Sub EnableControls(cons, bEnable As Boolean)
Dim con
For Each con In cons
With con
.Enabled = bEnable
.BackColor = IIf(bEnable, vbWhite, RGB(200, 200, 200))
End With
Next con
End Sub
Private Sub CommandButtonOk_Click()
Dim useAforB As Boolean
useAforB = CheckBox1.Value
Application.ScreenUpdating = False
With ActiveDocument
'....
.Bookmarks("Street").Range.Text = TextBoxStreet.Value
.Bookmarks("Suburb").Range.Text = TextBoxSuburb.Value
.Bookmarks("State").Range.Text = ComboBoxState.Value
.Bookmarks("PostCode").Range.Text = TextBoxpostcode.Value
.Bookmarks("Street2").Range.Text = IIf(useAforB, _
TextBoxStreet.Value, TextBoxStreet2.Value)
.Bookmarks("Suburb2").Range.Text = IIf(useAforB, _
TextBoxSuburb.Value, TextBoxSuburb2.Value)
.Bookmarks("State2").Range.Text = IIf(useAforB, _
ComboBoxState.Value, ComboBoxState2.Value)
.Bookmarks("PostCode2").Range.Text = IIf(useAforB, _
TextBoxpostcode.Value, TextBoxPostcode2.Value)
'...
End With
Application.ScreenUpdating = True
Unload Me
End Sub

VBA Variable as CommandButton#

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

Is it possible to do this code with less redundancy?

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

VBA to change slicer selection current selected item

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