Option
Explicit
Sub
TestDemo()
Dim
VArrLst
As
Object
Dim
oShp
As
Shape
Dim
oChart
As
Chart
Dim
oAxis
As
Axis
Dim
c
As
Range, rngDate
As
Range, rngValue
As
Range, rngSetChart
As
Range
Dim
dstart
As
Date
Dim
x
As
Long
, y
As
Long
, z
As
Long
Sheets(
"Test"
).Activate
Application.ScreenUpdating =
False
With
ActiveSheet
.Columns.Hidden =
False
.Rows.Hidden =
False
.Cells.Clear
For
Each
oShp
In
.Shapes
oShp.Delete
Next
oShp
Set
rngDate = .Range(
"B6:P6"
)
Set
rngValue = rngDate.Offset(8)
dstart =
Date
- WorksheetFunction.RandBetween(14, 28)
For
Each
c
In
rngDate
c.Value = dstart
c.Offset(8).Value = WorksheetFunction.RandBetween(1, 8) / 10
dstart = dstart + 1
Next
c
Set
VArrLst = CreateObject(
"System.Collections.ArrayList"
)
z = rngDate.Columns(rngDate.Columns.Count).Column
x = rngDate.Columns(1).Column
For
y = x
To
z
Set
c = .Cells(rngDate.Row, y)
If
Weekday(c.Value, 2) > 5
Then
With
.Columns(y)
.Interior.Color = 15132390
.Hidden =
True
End
With
Else
VArrLst.Add Format(c.Value,
"dd.mm.yyyy"
)
End
If
Next
y
Set
rngSetChart = Union(rngDate, rngValue).SpecialCells(xlCellTypeVisible)
Set
oShp = .Shapes.AddChart2(201, xlColumnClustered)
Set
oChart = .Shapes(1).Chart
oChart.SetSourceData Source:=rngSetChart
Set
oAxis = oChart.Axes(1)
oAxis.CategoryNames = VArrLst.toarray
.Columns.Hidden =
False
End
With
Application.ScreenUpdating =
True
End
Sub