Snasui Excel Forum

Code: Select all

Private Sub Creating_Click()

Application.ScreenUpdating = True

Me.LB1.Select

Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart
.SetSourceData Source:=LB1
.SeriesCollection(1).xlValues = ActiveSheet.Range("$G$2:$G$800")
.SeriesCollection(1).Values = ActiveSheet.Range("$H$2:$H$800")
End With

'set chart axis min and max
MyChart.Axes(xlValue).MaximumScale = 102
MyChart.Axes(xlValue).MinimumScale = 101
MyChart.Axes(xlValue).MaximumScaleIaAuto = True
MyChart.Axes(xlValue).MinimumScaleIaAuto = True

MyChart.Axes(Value).MaximumScale = 200
MyChart.Axes(Value).MinimumScale = 100
MyChart.Axes(Value).MaximumScaleIaAuto = True
MyChart.Axes(Value).MinimumScaleIaAuto = True

'Display axis
MyChart.HasAxis(xlCategory) = True

'Display axis
MyChart.Axes(xlCategory, xlSecondary).HasTite = True

'Add gridlines
MyChart.SetElement (msoElementPrimaryValueGridLinesMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
MyChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMinorMajor)

'Display chart title
MyChart.HasTitle = True

'Change colour of gridlines
MyChart.Axes(xlValue).MajorGridlines.Format.Line.ForeColor.RGB = RGB(255, 0, 0)

End Sub

Code: Select all

Private Sub Creating_Click()
Dim i As Integer
For i = 0 To LB1.ListCount - 1
LB1.ListIndex = i
Cells(i + 1, 1) = LB1.Text
Next i

'to create the Scetter line

Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart
.SetSourceData Source:=LB1
.SeriesCollection(1).xlValues = ActiveSheet.Range("$G$2:$G$300")
.SeriesCollection(1).Values = ActiveSheet.Range("$H$2:$H$300")
End With

'set chart axis min and max
MyChart.Axes(xlValue).MaximumScale = 102
MyChart.Axes(xlValue).MinimumScale = 101
MyChart.Axes(xlValue).MaximumScaleIaAuto = True
MyChart.Axes(xlValue).MinimumScaleIaAuto = True

MyChart.Axes(Values).MaximumScale = 200
MyChart.Axes(Values).MinimumScale = 100
MyChart.Axes(Values).MaximumScaleIaAuto = True
MyChart.Axes(Values).MinimumScaleIaAuto = True
' my error is Values


'Display axis
MyChart.HasAxis(xlCategory) = True

'Display axis
MyChart.Axes(xlCategory, xlSecondary).HasTite = True

'Add gridlines
MyChart.SetElement (msoElementPrimaryValueGridLinesMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
MyChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMinorMajor)

'Display chart title
MyChart.HasTitle = True

'Change color of gridlines
MyChart.Axes(xlValue).MajorGridlines.Format.Line.ForeColor.RGB = RGB(255, 0, 0)

End Sub

Code: Select all

Option Explicit

Dim sourceBook As Workbook

Private Sub Add_Click()
    Me.LB1.AddItem Me.COB1.Column(0)
End Sub

Private Sub Browse_Click()
    Dim YPath As Variant
    Dim wb As Workbook
    Dim ws As Worksheet
    YPath = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    File.Caption = YPath
    If YPath = False Then Exit Sub Else File.Caption = YPath
    
    COB1.Clear
    
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(File.Caption)
    Set sourceBook = wb
    ActiveWindow.Visible = False
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
    ActiveWindow.Visible = True
    
    
    For Each ws In wb.Worksheets
        COB1.AddItem ws.Name
    Next ws
End Sub

Private Sub Creating_Click()
Dim i As Integer
'For i = 0 To LB1.ListCount - 1
'LB1.ListIndex = i
'Cells(i + 1, 1) = LB1.Text
'Next i
LB1.ListIndex = 0
'to create the Scetter line

Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart
    .SetSourceData Source:=sourceBook _
        .Worksheets(Me.LB1.Text).Range("a1:i300")
    .SeriesCollection(1).Values = sourceBook.Worksheets(Me.LB1.Text).Range("$G$2:$G$300")
    .SeriesCollection(1).Values = sourceBook.Worksheets(Me.LB1.Text).Range("$H$2:$H$300")
End With

'set chart axis min and max
MyChart.Axes(xlValue).MaximumScale = 102
'MyChart.Axes(xlValue).MinimumScale = 101
'MyChart.Axes(xlValue).MaximumScaleIaAuto = True
'MyChart.Axes(xlValue).MinimumScaleIaAuto = True

'MyChart.Axes(xlValue).MaximumScale = 200
'MyChart.Axes(xlValue).MinimumScale = 100
'MyChart.Axes(xlValues).MaximumScaleIaAuto = True
'MyChart.Axes(xlValues).MinimumScaleIaAuto = True
' my error is Values


'Display axis
MyChart.HasAxis(xlCategory) = True

'Display axis
'MyChart.Axes(xlCategory, xlSecondary).HasTite = True
'MyChart.Axes(xlCategory).HasTite = True
'Add gridlines
MyChart.SetElement (msoElementPrimaryValueGridLinesMajor)
'MyChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
MyChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
'MyChart.SetElement (msoElementPrimaryCategoryGridLinesMinorMajor)

'Display chart title
MyChart.HasTitle = True

'Change colour of gridlines
'MyChart.Axes(xlValue).MajorGridlines.Format.Line.ForeColor.RGB = RGB(255, 0, 0)

End Sub

Private Sub Delete_Click()
    With Me.LB1
        .RemoveItem (.ListIndex)
    End With
End Sub

Code: Select all

Private Sub Creating_Click()
Dim i As Integer
For i = 0 To LB1.ListCount - 1
LB1.ListIndex = i
Cells(i + 1, 1) = LB1.Text
Next i
LB1.ListIndex = 0

'to create the Scetter line

Dim MyChart As Chart
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart
.SetSourceData Source:=sourceBook
Worksheets(Me.LB1.Text).Range ("a2:i300")
.SeriesCollection(1).Values = sourceBook.Worksheets(Me.LB1.Text).Range("$G$2:$G$300")
.SeriesCollection(1).Values = sourceBook.Worksheets(Me.LB1.Text).Range("$H$2:$H$300")
End With

'set chart axis min and max
'Y-Axis

MyChart.Axes(xlValue).MaximumScale = 235
MyChart.Axes(xlValue).MinimumScale = 210
MyChart.Axes(xlValue).MajorUnit = 5
MyChart.Axes(xlValue).MinorUnit = 1

'X-Axis
MyChart.Axes(xlCategory).MaximumScale = 101.824
MyChart.Axes(xlCategory).MinimumScale = 101.821
MyChart.Axes(xlCategory).MajorUnit = 0.0005
MyChart.Axes(xlCategory).MinorUnit = 0.0001

'Name the Y-Axis
MyChart.Axes(xlValue).HasTitle = True
MyChart.Axes(xlValue).AxisTitle.Text = "Ele(m.asl)"

'Name the x-Axis
MyChart.Axes(xlCategory).HasTitle = True
MyChart.Axes(xlCategory).AxisTitle.Text = "Longitude"

'Add gridlines
MyChart.SetElement (msoElementPrimaryValueGridLinesMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
MyChart.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
MyChart.SetElement (msoElementPrimaryCategoryGridLinesMinorMajor)

'Display chart title
MyChart.HasTitle = True

'Change colour of gridlines
MyChart.Axes(xlValue).MajorGridlines.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
][/End Sub]

Code: Select all

Sub mychart()
Dim mychart As Chart
Dim sourceBook As Workbook
Dim fname As String
Dim i As Integer

For i = 0 To LB1.Listcounr - 1
Cells(i + 1, 1) = LB1.Text
Next i
LB1.ListIndex = 0


Set mychart = Charts.Add
With mychart

chartarray1 = sourceBook.Worksheets(LB1.Text).Range("$G$2:$G$300")
Chartarray2 = sourceBook.Worksheets(LB1.Text).Range("$H$2:$H$300")

.SetSourceData Source:=sourceBook
Worksheets(LB1.Text).Range ("a2:i300")
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = " Cross Section"
.SeriesCollection(1).XValues = Chartarray2
.SeriesCollection(1).Values = chartarray1
.ChartType = xlXYScatterSmoothNoMarkers
.ChartStyle = 73
End With

ActiveChart.Export "D:\chartname.jpg"
f = ActiveSheet.Name
Sheets(f).Select
ActiveWindow.SelectedSheets.Visible = False
fname = "D:\chartname.jpg"
UserForm1.Image1.Picture = LoadPicture(fname)

End Sub

Code: Select all

Sub mychart()
    Dim mychart As Chart
    Dim sourceBook As Workbook
    Dim fname As String
    Dim sh As Worksheet
    Dim i As Integer

    DS.LB1.ListIndex = 0
    
    Set sourceBook = Workbooks(VBA.Split(DS.File.Caption, _
        "\")(UBound(VBA.Split(DS.File.Caption, "\"))))
    Set sh = sourceBook.Worksheets(DS.LB1.Text)
    
    Set mychart = Charts.Add
    With mychart
        chartarray1 = sh.Range("$G$2:$G$300")
        Chartarray2 = sh.Range("$H$2:$H$300")
        
        .SetSourceData Source:=sh.Range("a2:i300")
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = " Cross Section"
        .SeriesCollection(1).XValues = Chartarray2
        .SeriesCollection(1).Values = chartarray1
        .ChartType = xlXYScatterSmoothNoMarkers
'        .ChartStyle = 73
    End With
    
    ActiveChart.Export "D:\chartname.jpg"
    f = ActiveSheet.Name
    Sheets(f).Select
    ActiveWindow.SelectedSheets.Visible = False
    fname = "D:\chartname.jpg"
    DS.Image1.Picture = LoadPicture(fname)

End Sub

Code: Select all

Sub mychart()
    Dim mychart As Chart
    Dim sourceBook As Workbook
    Dim fname As String
    Dim sh As Worksheet
    Dim i As Integer

    DS.LB1.ListIndex = 0
    
    Set sourceBook = Workbooks(VBA.Split(DS.File.Caption, _
        "\")(UBound(VBA.Split(DS.File.Caption, "\"))))
    Set sh = sourceBook.Worksheets(DS.LB1.Text)
    
    Set mychart = Charts.Add
    With mychart
        Chartarray1 = sh.Range("$G$2:$G$300")
        Chartarray2 = sh.Range("$H$2:$H$300")
              
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = Chartarray1
        .SeriesCollection(1).Values = Chartarray2
        .ChartType = xlXYScatterSmoothNoMarkers
       '        .ChartStyle = 73

        mychart.Axes(xlCategory).HasTitle = True
        mychart.Axes(xlCategory).AxisTitle.Caption = "Longtiude"
        mychart.Axes(xlValue).HasTitle = True
        mychart.Axes(xlValue).AxisTitle.Caption = "Ele(m.asl)"
        
        'Chart Title "Cross section"
        mychart.Name = "Line information"
        
       ' To creat the Legend with is the LB1(listbox)?
       
        mychart.SetElement (msoElementLegendRight)
       

    End With
    
    ActiveChart.Export "D:\chartname.gif"
    f = ActiveSheet.Name
    Sheets(f).Select
    ActiveWindow.SelectedSheets.Visible = False
    fname = "D:\chartname.gif"
    DS.Image1.Picture = LoadPicture(fname)

End Sub

Code: Select all

Sub mychart()
    Dim ochart As Chart
    Dim sourceBook As Workbook
    Dim fname As String
    Dim sh As Worksheet
    Dim i As Integer
    
    'For loop
        For i = 1 To LB1.ListCount - 1
        LB1.ListIndex = i
        Cells(i + 1, 1) = LB1.Text
    Next i