Jhon,
I'm checking my image scanning algorithm with GetPixel, I'm going to test new coordinates.
Yes, only today I understood that the order in which coordinates are in the list makes a difference, not just the numbers of x / y.
But I would not want to have to delete from the Worsheet cells and not even from the chart the coordinates and not even the point (nodes).
"The procedure does not loop in a diagonal or in a circular fashion. The procedure loops from the first point to the last."
I want to first try to create an algorithm to use only the x / y coords of the desired Points (nondes of Chart) when using BuildFreeFormAddLines, so FreeFormBuilder will ignore the CoordsXY that do not satisfy the condition.
This way I will have in the Chart the original drawing and I will have in Shape the created drawing.
I believe this problem is the same as always when trying to create a drawing with Lines when the coordinates are for points.
====================================================
http://dailydoseofexcel.com/blogpix/mapstate2.gif
http://www.clearlyandsimply.com/.a/6a00e554d9fb99883301bb081f0cec970d-pi
Reading XML Files in VBA – Daily Dose of Excel
Create Excel Freeform Shapes from Polygons - Clearly and Simply
I do not want to create a filled shape, I want to create a leaked shape or the best it can be.
I believe it is possible to play with the XNode and YNode values with "If XNode = 'valueX' and Ynode = 'valueY then AddNodes'
I am already testing new coordinates but I do not know if they are correct and I can not adapt their code alone, but I believe that their code is the basis for the new algorithm.
Do you have some workbook example scanned the colors of the pixels of an image with GetPIxel method and put in a list of 2 XY columns as it is in my spreadsheet and that works in your code to create the shape drawing?
==================================================================
I want make a code shomething like this "PSEUDOCODE" :
---------------------------------------------------------------------
For Ipts = 1 To Npts
"................"
If Xnode = "VALUE" And Ynode = "VALUE"
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
myShape.Line.ForeColor.SchemeColor = 10
Set myBuilder = Nothing
End If
Next
=============================================================
Jhon, Please, Look at this version of your code from HerberForum i think:
Code:
Option Explicit
Sub ShadeBelow()
Dim myCht As Chart
Dim mySrs As Series
'Dim Npts As Integer, Ipts As Integer
Dim Npts As Long, Ipts As Long
Dim myBuilder As FreeformBuilder
Dim myShape As Shape
Dim Xnode As Double, Ynode As Double
Dim Xmin As Double, Xmax As Double
Dim Ymin As Double, Ymax As Double
Dim Xleft As Double, Ytop As Double
Dim Xwidth As Double, Yheight As Double
Dim NullNachMax As Integer
Dim Y_Value As Double, Y_Value_1 As Double
Dim X_Value As Double, X_Value_1 As Double
'If ActiveSheet.Type = xlWorksheet Then
'MsgBox "Bitte vor Start des Makros ein XY-Punkt-Diagramm aktivieren!"
'Exit Sub
'End If
'Set myCht = ActiveChart
Set myCht = ActiveSheet.ChartObjects("grafico1").Chart
'Call Shape_LoescheninChart(objSheet:=myCht)
Xleft = myCht.PlotArea.InsideLeft
Xwidth = myCht.PlotArea.InsideWidth
Ytop = myCht.PlotArea.InsideTop
Yheight = myCht.PlotArea.InsideHeight
Xmin = myCht.Axes(1).MinimumScale
Xmax = myCht.Axes(1).MaximumScale
Ymin = myCht.Axes(2).MinimumScale
Ymax = myCht.Axes(2).MaximumScale
Set mySrs = myCht.SeriesCollection(1)
Npts = mySrs.Points.Count
' first point
If mySrs.XValues(1) > Xmax Then
NullNachMax = 2 'die ersten X-Werte sind >Xmax
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
Else
NullNachMax = 1 'die letzten X-Werte sind >Xmax
' first point
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
End If
' remaining points
For Ipts = 1 To Npts
Y_Value = mySrs.Values(Ipts)
X_Value = mySrs.XValues(Ipts)
If Y_Value < Ymin Then
Y_Value = Ymin
End If
If Ipts > 1 Then
X_Value_1 = mySrs.XValues(Ipts - 1)
Y_Value_1 = mySrs.Values(Ipts - 1)
If Y_Value_1 < Ymin Then Y_Value_1 = Ymin
End If
If NullNachMax = 1 Then 'die letzten X-Werte sind > Xmax
If X_Value > Xmax Then
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - (Y_Value_1 _
+ (Y_Value - Y_Value_1) / (X_Value - X_Value_1) * (Xmax - X_Value_1))) _
* Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Exit For
Else
Xnode = Xleft + (X_Value - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - Y_Value) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
End If
ElseIf NullNachMax = 2 Then 'die ersten X-Werte sind > Xmax
Do Until X_Value < Xmax
Ipts = Ipts + 1
X_Value = mySrs.XValues(Ipts)
Y_Value = mySrs.Values(Ipts)
Loop
If Y_Value < Ymin Then Y_Value = Ymin
X_Value_1 = mySrs.XValues(Ipts - 1)
Y_Value_1 = mySrs.Values(Ipts - 1)
If Y_Value_1 < Ymin Then Y_Value_1 = Ymin
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - (Y_Value_1 _
+ (Y_Value - Y_Value_1) / (X_Value - X_Value_1) * (Xmax - X_Value_1))) _
* Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
NullNachMax = 0
ElseIf NullNachMax = 0 Then
Xnode = Xleft + (X_Value - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - Y_Value) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
End If
Next
If Ipts > Npts Then
'alle Punkte der Kurve im Diagramm
Xnode = Xleft + (mySrs.XValues(Npts) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Else
'Skalen-Max-Wert ist kleiner als der größte X-Wert
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
End If
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape
With myShape
' USE YOUR FAVORITE COLORS HERE
.Fill.ForeColor.SchemeColor = 12
.Line.Visible = False
End With
End Sub
''=====================================
'Sub Shape_LoescheninChart(Optional objSheet As Object, Optional lngType As Long = 5)
'''Type = 5 = Freihandform
' Dim objShape As Shape
'If objSheet Is Nothing Then Set objSheet = ActiveSheet
' For Each objShape In objSheet.Shapes
'With objShape
' If .Type = lngType Then
'.Delete
'Exit Sub
'End If
'End With
'Next
'Ende:
'Set objShape = Nothing
'End Sub
''=====================================
DETAIL OF HERBERFORUM VERSION OF JHON PELTIER CODE USING "IF" :
Code:
' first point
If mySrs.XValues(1) > Xmax Then
NullNachMax = 2 'die ersten X-Werte sind >Xmax
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
Else
NullNachMax = 1 'die letzten X-Werte sind >Xmax
' first point
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
End If
' remaining points
For Ipts = 1 To Npts
Y_Value = mySrs.Values(Ipts)
X_Value = mySrs.XValues(Ipts)
If Y_Value < Ymin Then
Y_Value = Ymin
End If
If Ipts > 1 Then
X_Value_1 = mySrs.XValues(Ipts - 1)
Y_Value_1 = mySrs.Values(Ipts - 1)
If Y_Value_1 < Ymin Then Y_Value_1 = Ymin
End If
If NullNachMax = 1 Then 'die letzten X-Werte sind > Xmax
If X_Value > Xmax Then
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - (Y_Value_1 _
+ (Y_Value - Y_Value_1) / (X_Value - X_Value_1) * (Xmax - X_Value_1))) _
* Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Exit For
Else
Xnode = Xleft + (X_Value - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - Y_Value) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
End If
ElseIf NullNachMax = 2 Then 'die ersten X-Werte sind > Xmax
Do Until X_Value < Xmax
Ipts = Ipts + 1
X_Value = mySrs.XValues(Ipts)
Y_Value = mySrs.Values(Ipts)
Loop
If Y_Value < Ymin Then Y_Value = Ymin
X_Value_1 = mySrs.XValues(Ipts - 1)
Y_Value_1 = mySrs.Values(Ipts - 1)
If Y_Value_1 < Ymin Then Y_Value_1 = Ymin
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - (Y_Value_1 _
+ (Y_Value - Y_Value_1) / (X_Value - X_Value_1) * (Xmax - X_Value_1))) _
* Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
NullNachMax = 0
ElseIf NullNachMax = 0 Then
Xnode = Xleft + (X_Value - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + (Ymax - Y_Value) * Yheight / (Ymax - Ymin)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
End If
Next
If Ipts > Npts Then
'alle Punkte der Kurve im Diagramm
Xnode = Xleft + (mySrs.XValues(Npts) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
Else
'Skalen-Max-Wert ist kleiner als der größte X-Wert
Xnode = Xleft + (Xmax - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
End If
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
Ynode = Ytop + Yheight
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
Set myShape = myBuilder.ConvertToShape