Errorbars formatting in Excel 2007 - vba

Using a macro in excel 2007 I want to display the following errorbars:
No horizontal errorbar.
Red dashed with 100 plus value vertical errorbar.
I can get everything I want except the color and I don't understand why. Below is the code.
ActiveChart.SeriesCollection(6).HasErrorBars = True
With ActiveChart.SeriesCollection(6).ErrorBars
.EndStyle = xlNoCap
.Format.Line.Visible = msoTrue
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.ForeColor.TintAndShade = 0
.Format.Line.Weight = 2
.Format.Line.DashStyle = msoLineDash
End With
ActiveChart.SeriesCollection(6).ErrorBar Direction:=xlX, Include:=xlNone, Type:=xlFixedValue, Amount:=0
ActiveChart.SeriesCollection(6).ErrorBar Direction:=xlY, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=100

I ran into the same issue too. But after toggling the visible state of the error bars, the color change worked for me. Give this a try:
ActiveChart.SeriesCollection(6).HasErrorBars = True
With ActiveChart.SeriesCollection(6).ErrorBars
.EndStyle = xlNoCap
.Format.Line.Visible = msoTrue
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.Visible = False 'ADDED
.Format.Line.Visible = True 'ADDED
.Format.Line.ForeColor.RGB = RGB(255, 0, 0) 'ADDED
.Format.Line.ForeColor.TintAndShade = 0
.Format.Line.Weight = 2
.Format.Line.DashStyle = msoLineDash
End With

Related

Bullets and indents not giving expected results

I'm trying to standardize the format the bullets of individual shapes but am not getting the results I want. The code is below.
The results I'm looking for are for the first level to have no bullet or indent and the rest of the bullets to be slightly indented from the start of the text of the previous level and the shapes alternating between dot and dash.
I've spent a couple of hours researching but haven't made any advances except to learn that I shouldn't use rulers. I don't understand what I should use instead for the indenting.
When I apply them to an existing shape, nothing works out as planned. I also can't get them to update automatically and have to go to the paragraph/bullet button on the ribbon for it to take efect.
Thanks in advance for your help.
Option Explicit
Global Const emDefaultStyleSpaceWithin = 0.9
Global Const emDefaultStyleSpaceBefore = 0.4
Global Const emDefaultStyleSpaceAfter = 0
Public Sub SetParagraphFormat()
Dim oParagraphFormat As ParagraphFormat
Dim Level As Single
Set oParagraphFormat = ActiveWindow.Selection.textRange.ParagraphFormat
With oParagraphFormat
' Set line spacing
If emDefaultStyleSpaceWithin Then
.LineRuleWithin = msoTrue
.SpaceWithin = emDefaultStyleSpaceWithin
Else
.SpaceWithin = 0
End If
If emDefaultStyleSpaceBefore Then
.LineRuleBefore = msoTrue
.SpaceBefore = emDefaultStyleSpaceBefore
Else
.SpaceBefore = 0
End If
.LineRuleAfter = msoTrue
.SpaceAfter = 0
' Set bullet format
.Bullet.RelativeSize = 1
For Level = 1 To 5
Select Case Level
Case 1
.Bullet.font.Name = "Arial"
.Bullet.Character = 8226
.Bullet.Visible = msoFalse
Case 2
.Bullet.font.Name = "Arial"
.Bullet.Character = 8226
Case 3
.Bullet.font.Name = "Arial"
.Bullet.Character = 8211
Case 4
.Bullet.font.Name = "Arial"
.Bullet.Character = 8226
Case 5
.Bullet.font.Name = "Arial"
.Bullet.Character = 8211
End Select
Next Level
End With
With ActiveWindow.Selection.ShapeRange.textFrame.Ruler
With .Levels(1)
.FirstMargin = 0
.LeftMargin = 0
End With
With .Levels(2)
.FirstMargin = 3
.LeftMargin = 17
End With
With .Levels(3)
.FirstMargin = 20
.LeftMargin = 30
End With
With .Levels(4)
.FirstMargin = 33
.LeftMargin = 45
End With
With .Levels(5)
.FirstMargin = 48
.LeftMargin = 51
End With
End With
End Sub

How to draw and format a line?

I am trying to draw a line in a PowerPoint presentation. I cannot get the desired combinations of colour, weight, zorder and to name it.
I have two ways to draw a line.
The first:
Set oLine = MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5) - 5, MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line"
End With
With this only the zorder works. The colour of the line is a shade of blue (which I believe was used earlier in the PowerPoint).
The second:
With MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5), MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 5
End With
This gives the desired colour and weight, but I cannot find a way to zorder the shape nor name it.
How can I achieve all of my desired combinations?
Lines don't use a fill, only 2D shapes.
It's easier to find errors if you break long commands (like the one starting with Set oLine) into smaller chunks until you get it working. You omitted information about the MyShape from which you're getting positions, but here is a revised version of your code that runs:
Sub FormatLine()
Dim oLine As Shape
Set oLine = ActivePresentation.Slides(1).Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=40, EndY:=40)
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line3"
End With
End Sub

VBA Excel : Adding a second set of commands if Textbox is changed

I am busy building a Shift rotation schedule using VBA and Excel
at the moment I am sitting with a problem
In my Userform I have 434 textboxes that give the shift allocation per agent
as seen below:
Now in order to get these colours to change I have a code in every Textbox (Named A1,A2.....A31 then B1, B2,,,,,,B31 etc.)
the code goes as follows:
Private Sub A1_Change()
If A1.Text = "A" Then
A1.BackColor = &H602000
ElseIf A1.Text = "B" Then
A1.BackColor = &HC07000
ElseIf A1.Text = "C" Then
A1.BackColor = &HEED7BD
ElseIf A1.Text = "D" Then
A1.BackColor = &HF0B000
ElseIf A1.Text = "W" Then
A1.BackColor = &HFF&
ElseIf A1.Text = "M" Then
A1.BackColor = &H808080
ElseIf A1.Text = "S" Then
A1.BackColor = &HA6A6A6
ElseIf A1.Text = "P" Then
A1.BackColor = &H7D7DFF
ElseIf A1.Text = "L" Then
A1.BackColor = &HD9D9D9
End If
End Sub
I am trying now to allow the user to edit the shifts manually, Once this is done, they would be able to click on a set button that will copy the data from the Specific Agents row onto the worksheet based on the month selected for example:
Private Sub CommandButton2_Click()
If Sheets(3).Range("B5").Text = "2018-01-01" Then
Worksheets("LAYOUT").Activate
Sheets("LAYOUT").Range(B4).Text = A1.Value
Sheets("LAYOUT").Range(C4).Text = A2.Value
Sheets("LAYOUT").Range(D4).Text = A3.Value
Sheets("LAYOUT").Range(E4).Text = A4.Value
Sheets("LAYOUT").Range(F4).Text = A5.Value
.
.
.
.
Sheets("LAYOUT").Range(AD4).Text = A29.Value
Sheets("LAYOUT").Range(AE4).Text = A30.Value
Sheets("LAYOUT").Range(AF4).Text = A31.Value
ElseIf Sheets(3).Range("B5").Text = "2018-02-01" Then
Worksheets(1).Activate
Sheets("LAYOUT").Range(AG4).Text = A1.Value
.
.
.
.
.
Sheets("LAYOUT").Range(BJ4).Text = A30.Value
Sheets("LAYOUT").Range(BK4).Text = A31.Value
ElseIf Sheets(3).Range("B5").Text = "2018-03-01" Then
Worksheets(1).Activate
Sheets("LAYOUT").Range(BI4).Text = A1.Value
Sheets("LAYOUT").Range(BJ4).Text = A2.Value
ect
Now when I make a change and click on the CommandButton2
it does nothing... Where am I going wrong?
Wow, that's... um... really something. You get an 'A' for for Determination, but a "C-" for Study Skills. (I mean that in the kindest way possible!) :)
There are a lot of ways to create a dynamic multicolored form like this (with no sensitive code available to the users) and you pretty much picked the hardest and most complicated way. Unfortunately, complicating simple tasks tends to make them more likely to break in the future for a small reason, and then it can take forever to figure out the problem, if you're baby doesn't crash altogether, losing all your data.
I don't think I've ever seen a Too Many Variables error before! (Even Excel wants you to simplify.) Sorry if this doesn't qualify as an answer, but I think you're best best it to start over with your formatting in a proper way.
omg, "5208 lines of code left") IF you know exactly how many lines of code you have left, you are being way too repetitive! The whole point of Excel, or VBA, or coding in general, is make the computer do the work!
If you're concerned about learning new Excel features, don't be. You obviously have some skill & organization to have made it as far as you did on that! There are some basic things you should teach yourself in Excel...
Some things to learn, ASAP (you will be glad you did!)
Select..Case statements (instead of ElseIf ElseIf ElseIf)
With..End With statements (instead of A1.BackColor A1.BackColor A1.BackColor)
VLookup (store reusable values in tables)
Match / Index
Protecting Worksheets in Excel
CONDITIONAL FORMATTING! (Automatically change a cell's color etc based on a value or a formula.)
Arrays! Both for storage (like color names and cell trigger values) and for control.
VBA Events! (Make stuff happen automatically when other stuff happens) --from the website of Chip Pearson (the king of Excel)
Making a static web page of an Excel Page
Some of Excel's amazing built-in features
Microsoft Excel formulas and features that you need to know
ExcelGuru Forums
and even: Rotating Shift Schedule Templates for Excel (that are ready to use, free, you can adapt as you need, built by professionals)
Good luck... Those are some nice color choices!
The best way to solve this issue is to start creating modules for each "action" that you want to do, for example to insure the colors in the textboxes make one Module and call it "Colour_Text" as an example is would look something like this
Public Sub Colour_Text1()
If PA1.Text = "S1" Then
PA1.BackColor = RGB(0, 32, 96)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "S2" Then
PA1.BackColor = RGB(0, 112, 192)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "S3" Then
PA1.BackColor = RGB(189, 215, 238)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "S4" Then
PA1.BackColor = RGB(0, 176, 240)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "W" Then
PA1.BackColor = RGB(60, 60, 60)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "P" Then
PA1.BackColor = RGB(166, 166, 166)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "A" Then
PA1.BackColor = RGB(255, 0, 0)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "S" Then
PA1.BackColor = RGB(169, 208, 142)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "L" Then
PA1.BackColor = RGB(0, 176, 80)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "F" Then
PA1.BackColor = RGB(112, 48, 160)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "N" Then
PA1.BackColor = RGB(255, 125, 125)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "UL" Then
PA1.BackColor = RGB(0, 176, 80)
PA1.ForeColor = RGB(169, 208, 142)
PA1.Font.Bold = True
ElseIf PA1.Text = "US" Then
PA1.BackColor = RGB(169, 208, 142)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "UN" Then
PA1.BackColor = RGB(255, 125, 125)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "H" Then
PA1.BackColor = RGB(255, 192, 0)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
End If
End Sub
You then do the same for all the other text boxes, you can then call the module when you change the Text box like this:
Private Sub PA1_Change()
Call Module1.Colour_Text1
End Sub
This way you are only calling small changes thus freeing up your Memory :)

Set Column BackColor in Datagridview to override Row BackColor in VB.net

working in vb.net in Visual Studio on a datagridview.
The rows are days of the week. The rows all alternate backcolor (variables LightColour1 and LightColour2), then the weekend rows are variable WeekendRowsColour. That's all easy enough, but now I have to make the entire final column white. But I can't seem to override the row colors no matter how I approach it. Any advice?
Here's my code section:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
Next
dgv.Columns(dgv.Columns.Count - 1).DefaultCellStyle.BackColor = Color.White
But no matter how I approach it, the last column comes out the default color. My best success has been setting the backcolor and alternatingrowsbackcolor of the rows programmatically, and setting the column properties to white in the designer, but that doesn't overwrite the alternating rows or the weekend colors.
Pulling my hair out here!
You have to set it inside the loop per cell like this:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
dgv.Rows(r).Cells(dgv.Columns.Count-1).Style.BackColor = Color.White
Next

Changing the color of a textbox in VBA (shading off/colour gradient)

I am trying to insert an automated summary at the beginning of my PowerPoint presentation in VBA. (I am fairly new to Visual Basic)
I have found the code that gives me the references, but I can't seem to figure out the colour gradient of one shape.
With ActivePresentation.Slides(1)
.Shapes(1).Fill.Visible = msoTrue
.Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
.Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
.Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
.Shapes(1).Line.Visible = msoFalse
The doc on the internet says the method is ForeColor and BackColor, but I can't seem to get it working. I don't understand why the second color is white and not dark red as its RGB code says.
my current template has the title on the side, and vertical, text towards the right side. The textbox is colored with a shading from RGB(208, 30, 60) to RGB(97, 18, 30) linearly with an angle of 270°.
this what is given by the complete VBA code (at the end)
This what I would like to have (with the numbers as shown in the VBA Slide)
Complete code:
Sub Sommaire()
Dim Diapo As Slide
Dim titre As Shape
Dim petit_titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte
'Si le titre de la première diapo est "Sommaire", elle sera supprimée
'cela permet de relancer la macro autant de fois que l'on souhaite
'sans avoir à supprimer la diapo de sommaire
If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "SOMMAIRE" Then
ActivePresentation.Slides(1).Delete
End If
' ajoute une diapo en début de présentation avec
'la disposition de mise en titre n°2 du masque
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "SOMMAIRE"
.Shapes(1).TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
.Shapes(1).TextFrame.TextRange.Font.Name = "Arial Black"
.Shapes(1).TextFrame.TextRange.Font.Size = 24
.Shapes(1).TextFrame2.TextRange.Font.Spacing = 3
.Shapes(1).TextFrame2.VerticalAnchor = msoAnchorBottom
.Shapes(1).TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignLeft
.Shapes(1).TextFrame2.MarginLeft = 14.1732283465
.Shapes(1).TextFrame2.MarginRight = 14.1732283465
.Shapes(1).TextFrame2.MarginTop = 14.1732283465
.Shapes(1).TextFrame2.MarginBottom = 28.3464566929
.Shapes(1).TextFrame2.WordWrap = msoTrue
.Shapes(1).TextFrame.Orientation = msoTextOrientationUpward
.Shapes(1).Left = 0 * 72
.Shapes(1).Top = 0 * 72
.Shapes(1).Height = ActivePresentation.PageSetup.SlideHeight
.Shapes(1).Width = 0.975 * 72
.Shapes(1).Fill.Visible = msoTrue
.Shapes(1).Fill.ForeColor.RGB = RGB(208, 30, 60)
.Shapes(1).Fill.BackColor.RGB = RGB(97, 18, 30)
.Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, 2
.Shapes(1).Line.Visible = msoFalse
.Shapes(1).Shadow.Type = msoShadow25
.Shapes(1).Shadow.Visible = msoTrue
.Shapes(1).Shadow.Style = msoShadowStyleInnerShadow
.Shapes(1).Shadow.Blur = 5
.Shapes(1).Shadow.OffsetX = 3.9993907806
.Shapes(1).Shadow.OffsetY = -0.0698096257
.Shapes(1).Shadow.ForeColor.RGB = RGB(52, 9, 16)
.Shapes(1).Shadow.Transparency = 0.5
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With
With ActivePresentation.Slides(1).Shapes _
.AddShape(msoShapeRectangle, 1.5275 * 72, 32.7, 180, 29.1)
.TextFrame.TextRange.Text = "Sommaire"
.TextFrame.MarginBottom = 10
.TextFrame.MarginLeft = 10
.TextFrame.MarginRight = 10
.TextFrame.MarginTop = 10
.TextFrame.TextRange.Font.Name = "Arial Black"
.TextFrame.TextRange.Font.Size = 18
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignLeft
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = RGB(208, 30, 60)
.TextFrame2.TextRange.Characters(2, 7).Font.Fill.ForeColor.RGB = RGB(39, 39, 39)
.Shadow.Visible = msoFalse
End With
'boucle sur toutes les diapos à partir de la 2e
For y = 2 To ActivePresentation.Slides.Count
Set Diapo = ActivePresentation.Slides(y)
'si la diapo a un titre
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte_ajout = texte_ajout & Format(y, "0 - ") & titre.TextFrame. _
TextRange.Text & Chr(13) & vbCrLf
End If
Next y
'ajout de liens aux items du sommaire
Set texte_sommaire = _
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange
texte_sommaire.Font.Size = 20
texte_sommaire.Font.Color.RGB = RGB(39, 39, 39)
With ActivePresentation.Slides(1).Shapes(2)
.Left = 1.5275 * 72
.Top = 1.9 * 72
End With
End Sub
Thank you in advance
I picked that from Excel macro recorder, as Shapes and most of the objects still have a lot of commons parts between Office applications.
ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
With Selection.ShapeRange
With .Fill
.ForeColor.RGB = RGB(255, 0, 0)
.BackColor.RGB = RGB(0, 0, 1)
.TwoColorGradient msoGradientHorizontal, 1
.RotateWithObject = msoTrue
.Visible = msoTrue
End With
With .TextFrame2.TextRange.Font
.BaselineOffset = 0
.Spacing = 1.6
End With
End With
You only need to "attach" (replace the Selection) it to your textbox, but I think you can handle that. I'll edit my answer to include all pointers I gave you in comments too.