For i = 2 To 7
If SlideSeen(i) = False Then GoTo EndSlide
Next i
How do I make the logic in such a manner that I can make an If Condition reading multiple items of an array.
In this case: If SlideSeen(2) to SlideSeen(7) = false Then Goto EndSlide
EDIT: This code works:
Dim allTrues As Boolean
allTrues = True
For i = 2 To 7
If SlideSeen(i) = False Then allTrues = False
Next
If allTrues = True Then
'
Else
'
End If
One option is to check if any of those array elements are True... if not, all are False.
For i = 2 To 7
Dim anyTrues As Boolean
If slideSeen(i) Then anyTrues = True
Next
If Not anyTrues Then GoTo EndSlide
though I would caution against using GoTo here as that could be the start of spaghetti code.
Related
I am looking for a vba command which checks first whether MS Project plan is checked out in the server. If it is not checked out then trigger the macros saved in the MS Project plan and if it is checked out by any other user, then skip that particular MS Proj plan and move to the next one.
I am using below command but it is not getting validated:
If objProject.IsCheckedOut(docCheckOut) = False Then
objProject.ActiveProject.CheckoutProject
where, docCheckOut is the MS Project plan.
Full Code:
Sub Test()
Dim mppName, mppFiles(0 To 2), strMacroName(0 To 3) As String
Dim fileCounter, macroCounter As Integer
Dim objProject As Object
Dim docCheckOut As String
mppFiles(0) = "CMD_mpp1"
mppFiles(1) = "CMD_mpp2"
mppFiles(2) = "CMD_mpp3"
strMacroName(0) = "CMD_Macro1"
strMacroName(1) = "CMD_Macro2"
strMacroName(2) = "CMD_Macro3"
strMacroName(3) = "CMD_Macro4"
Set objProject = CreateObject("MSProject.Application")
Application.DisplayAlerts = False
objProject.DisplayAlerts = False
'
For fileCounter = 0 To 2
docCheckOut = mppFiles(fileCounter)
On Error GoTo L1
objProject.FileOpenEx Name:="<>\" & docCheckOut, ReadOnly:=True, DoNotLoadFromEnterprise:=False
objProject.Application.Visible = True
If objProject.IsCheckedOut(docCheckOut) = False Then
objProject.ActiveProject.CheckoutProject
If objProject.IsCheckedOut(objProject.ActiveProject.Name) Then
MsgBox "checked out"
For macroCounter = 0 To 3
objProject.Application.Macro strMacroName(macroCounter)
objProject.Application.FileSave
objProject.Application.Publish
Next macroCounter
Else
MsgBox "Not checked out"
GoTo L1
End If
L1: Next fileCounter
Application.DisplayAlerts = True
objProject.DisplayAlerts = True
End Sub
Can anyone please suggest other command if any?
I have some code I have used to color excel charts with for quite a few years and it has worked well, (although there are likely better ways to do it). The charts contain 2 series, the first series with a value and the second with a goal. The goal does not get colored but the vba loops through the first series and colors according to hard coded goals in the vba.
The problem I have now is that I have added a chart that has a goal that can change month to month so having the hard coding doesn't work. How can I use the same theory but compare series 1 data directly to series 2 data to determine the color, (Case Is series 1 point > series 2 point, etc). I have tried a number of ways without success so any assistance would be greatly appreciated. below is the code for the proven technique.
Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim V As Variant
Dim Counter As Integer
For Each cht In ActiveSheet.ChartObjects
Counter = 0
V = cht.Chart.SeriesCollection(1).Values
For Each p In cht.Chart.SeriesCollection(1).Points
Counter = Counter + 1
Select Case V(Counter)
'Case Is = 1
'p.Shadow = False
'p.InvertIfNegative = False
'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
' Degree:=0.78
'p.Fill.Visible = True
'p.Fill.ForeColor.SchemeColor = 5
Case Is < 0.98
p.Shadow = False
p.InvertIfNegative = False
p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
Degree:=0.78
p.Fill.Visible = True
p.Fill.ForeColor.SchemeColor = 3
'Case Is < 0.98
'p.Shadow = False
'p.InvertIfNegative = False
'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, _
' Degree:=0.38
'p.Fill.Visible = True
'p.Fill.ForeColor.SchemeColor = 6
Case Is <= 1
p.Shadow = False
p.InvertIfNegative = False
p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
Degree:=0.78
p.Fill.Visible = True
p.Fill.ForeColor.SchemeColor = 10
End Select
Next
Next
End Sub
Did you try something like:
Case Is > .SeriesCollection(2).Values()(Counter)
Also revised to get rid of some apparent redundancy (if need a loop and a counter variable, e.g., when looping several collections/arrays in parallel), it seems better IMO to just loop by index, rather than For Each _object_ with a separate counter.
Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim V As Variant
Dim Counter As Integer
For Each cht In ActiveSheet.ChartObjects
Counter = 0
With cht.Chart
V = .SeriesCollection(1).Values
For Counter = 1 to.SeriesCollection(1).Points.Count
'Assign your Point object, if needed elsewhere
Set p = .SeriesCollection(1).Points(Counter)
Select Case V(Counter)
Case Is > .SeriesCollection(2).Values()(Counter)
'DO STUFF HERE.
'Add other cases if needed...
End Select
Next
End With
Next
End Sub
And unless you need the values in an array V for some other reason, this can be further reduced:
Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim val1, val2
Dim Counter As Integer
For Each cht In ActiveSheet.ChartObjects
Counter = 0
With cht.Chart
For Counter = 1 to.SeriesCollection(1).Points.Count
'Assign your Point object, if needed elsewhere
Set p = .SeriesCollection(1).Points(Counter)
' extract specific point value to variables:
val1 = .SeriesCollection(1).Values()(Counter)
val2 = .SeriesCollection(2).Values()(Counter)
Select Case V(Counter)
Case val1 > val2
'DO STUFF HERE.
'Add other cases if needed...
End Select
Next
End With
Next
End Sub
Edited with final code, The gradient needed 2 refreshes to completely fill in, (I would have to hit another tab and then go back), so I added a loop to run the code through twice and now it updates perfect the first time. Hopefully this helps others. This allows for a completely dynamic chart. Again, thank you David.
Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim V As Variant
Dim Counter As Integer
Dim L As Integer
For L = 1 To 2
For Each cht In ActiveSheet.ChartObjects
Counter = 0
With cht.Chart
V = cht.Chart.SeriesCollection(1).Values
For Counter = 1 To .SeriesCollection(1).Points.Count
Set p = .SeriesCollection(1).Points(Counter)
Select Case V(Counter)
'Blue Gradient
'Case Is = .SeriesCollection(2).Values()(Counter)
'p.Shadow = False
'p.InvertIfNegative = False
'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
' Degree:=0.78
'p.Fill.Visible = True
'p.Fill.ForeColor.SchemeColor = 5
'Red Gradient
Case Is < .SeriesCollection(2).Values()(Counter)
p.Shadow = False
p.InvertIfNegative = False
p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
Degree:=0.78
p.Fill.Visible = True
p.Fill.ForeColor.SchemeColor = 3
'Yellow Gradient
'Case Is < .SeriesCollection(2).Values()(Counter)
'p.Shadow = False
'p.InvertIfNegative = False
'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, _
' Degree:=0.38
'p.Fill.Visible = True
'p.Fill.ForeColor.SchemeColor = 6
'Green Gradient
Case Is >= .SeriesCollection(2).Values()(Counter)
p.Shadow = False
p.InvertIfNegative = False
p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
Degree:=0.78
p.Fill.Visible = True
p.Fill.ForeColor.SchemeColor = 10
End Select
Next
End With
Next
Next L
End Sub
I have an exported Word document in which tables constructed by a database extractor have space between wrapped lines in cells that I can remove by selecting the table and using the paragraph dialog box, but there are many tables and I want to automate this.
All I have to do after selecting all the tables in the document (which I can do with VBA) is set Add Space Before and Add Space After both = 0, which I think, secretly also sets the AddSpaceBeforeAuto = AddSpaceAfterAuto = False.
So I started with a simple select subroutine:
Sub selecttables()
Dim mytable As Table
Application.ScreenUpdating = False
For Each mytable In ActiveDocument.Tables
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
Application.ScreenUpdating = True
End Sub
This works fine and leaves all my tables selected. All I want to do now is set the appropriate ParagraphFormat members to mimic my setting of these properties in the Paragraph Dialog to zero and false.
I tried three approaches:
1. Set the values globally for the Normal style (which all the tables use)
2. Set the values for each table as they are selected
3. Set the values on the total selection, after all the tables are selected.
When I do this manually after selecttables() executes, I am doing method 3.
The function below actually tries all three methods. I have selectively commented them out and discovered that no one of the methods works and doing all three doesn't help any.
I tried both "With Selection.Range.Style.ParagraphFormat" and "With Selection.Range.ParagraphFormat" for METHOD 3, but neither worked.
I would also like to set the table property, "Allow row to break across pages" to False (because, seriously, the default value of True is really dumb!) and can't figure how to do that either.
Here is the function:
Sub FixTables()
Dim mytable As Table
Dim i As Integer
Application.ScreenUpdating = False
' METHOD 1:
ActiveDocument.Styles("Normal").ParagraphFormat.Space1
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceAfter = 0
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBefore = 0
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceAfterAuto = False
ActiveDocument.Styles("Normal").ParagraphFormat.SpaceBeforeAuto = False
For Each mytable In ActiveDocument.Tables
' METHOD 2:
With mytable.Style.ParagraphFormat
.Space1
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
'
With Selection.Style.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
Application.ScreenUpdating = True
End Sub
I botched METHOD 3, by referring to the table reference I used in
METHOD 2 rather than the current Selection. Here is the correct answer:
Sub FixTables()
Dim mytable As Table
Application.ScreenUpdating = False
For Each mytable In ActiveDocument.Tables
mytable.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone)
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Application.ScreenUpdating = True
End Sub
Hye there, I new with vba here.
I want to use checkboxes to link with the series collections of a chart. I put the check boxes in a sheet which contain the chart altogether. I have a lot of checkboxes here to be assigned to "true" value.
Private Sub Controls_Initialize()
'Make default for checkboxes
CheckBox1.Value = True
CheckBox2.Value = True
CheckBox3.Value = True
CheckBox4.Value = True
CheckBox5.Value = True
CheckBox6.Value = True
CheckBox7.Value = True
CheckBox8.Value = True
CheckBox9.Value = True
CheckBox10.Value = True
CheckBox11.Value = True
CheckBox12.Value = True
CheckBox13.Value = True
CheckBox14.Value = True
CheckBox15.Value = True
CheckBox16.Value = True
CheckBox17.Value = True
CheckBox18.Value = True
CheckBox19.Value = True
CheckBox20.Value = True
CheckBox21.Value = True
CheckBox22.Value = True
CheckBox23.Value = True
CheckBox24.Value = True
End Sub
I have tried this code but can't
For i = 1 to 24
Controls("CheckBox" & i).Value = True
Next i
The questions are
1. Is there any other code that can make it simple?
2. How to link the check boxes with the series collection in the activechart? Example, if the checkbox return value false, the series collection will be deleted/hide(perhaps?). And when it returns value true, the series collection of the same data will be added back in the chart. I would like to make the chart interactive.
If there is any reference that I can reviewed, do tell me.
Thanks in advance.
Regards.
Alright, so assuming from what you've given, I'd think the problem is that the interpreter doesn't know i is an integer.
To fix this, we can implement something along the lines of Dim i As Integer to implement i as an integer.
We could try this:
Dim i As Integer
For i = 1 to 24
Controls("CheckBox" & i).Value = True
Next i
I have the following code looping through a variety of arrayed controls in a form:
For r As Long = LBound(ctrlArray) To UBound(ctrlArray)
If TypeOf ctrlArray(r) Is TextBox Then
ctrlArray(r).Text = ""
If ctrlArray(r).ReadOnly = False Then
ctrlArray(r).ReadOnly = True
End If
Else
If ctrlArray(r).Enabled = True Then
ctrlArray(r).Enabled = False
End If
End If
Next
I receive the error "'ReadOnly' is not a member of System.Windows.Forms.Control" when trying to set textboxes as read only.
Solved this right before I hit the submit button. Thought I would share anyway:
Dim tbx As TextBox
For r As Long = LBound(ctrlArray) To UBound(ctrlArray)
If TypeOf ctrlArray(r) Is TextBox Then
ctrlArray(r).Text = ""
tbx = ctrlArray(r)
If tbx.ReadOnly = False Then
tbx.ReadOnly = True
End If
Else
If ctrlArray(r).Enabled = True Then
ctrlArray(r).Enabled = False
End If
End If
Next