Hi ,
I am a beginner in VBA but I need to amend a VBA code from an old colleague
The purpose of the code is to
1) create a chart of all elements on the vertical axis) against a 24 hour time represented in seconds on the horizontal axis.
the problem is that
1) the chart get created ,but not all the elements on the vertical axis gets shown on the vertical axis.
it seems to skip a few elements .
I found a way of manually forcing it to show all elements by going to Menu - Format axis -> axis options -> interval between labels --> specify interval unit = 1.
But i would like to put this in the VBA code below this so that all rows on the y axis gets a row on my chart.
The VBA code is below
Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long
Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)
Function CmdToSTr(Cmd As Long) As String
Dim Buffer() As Byte
Dim StrLen As Long
If Cmd Then
StrLen = lstrlenW(Cmd) * 2
If StrLen Then
ReDim Buffer(0 To (StrLen - 1)) As Byte
CopyMemory Buffer(0), ByVal Cmd, StrLen
CmdToSTr = Buffer
End If
End If
End Function
Sub processinput(cmdline)
filepos = Application.Find("/e/", cmdline)
If Not IsError(filepos) Then
ifile = Mid(cmdline, filepos + 3)
loadfile (ifile)
Call createprocesscharts
ActiveWorkbook.Close True
End If
End Sub
Sub createprocesscharts()
Dim sets(2, 365) As Long
Dim limits(2, 365) As Long
Dim dates(365) As String
c = 1
r = 2
Sheets("Sheet1".Select
dt = Cells(r, 5)
sets(1, c) = r
limits(1, c) = Cells(r, 2)
While (Cells(r, 5) <> ""
If Cells(r, 5) <> dt Then
sets(2, c) = r - 1
limits(2, c) = Cells(r - 1, 2)
dates(c) = Format(Cells(r - 1, 5), "ddd, d mmm yyyy"
dt = Cells(r, 5)
c = c + 1
sets(1, c) = r
limits(1, c) = Cells(r, 2)
End If
r = r + 1
Wend
sets(2, c) = r - 1
limits(2, c) = Cells(r - 1, 2)
dates(c) = Format(Cells(r - 1, 5), "ddd, d mmm yyyy"
For i = 1 To c
Debug.Print sets(1, i) & " " & sets(2, i) & " " & limits(1, i) & " " & limits(2, i) & " " & dates(i)
Call makechart(sets(1, i), sets(2, i), dates(i), limits(1, i), limits(2, i))
Next
End Sub
Sub makechart(r1 As Long, r2 As Long, dt As String, l1 As Long, l2 As Long)
Sheets("Sheet1".Select
rstart = "$A$" & r1
rend = "$C$" & r2
rg = "'Sheet1'!" & rstart & ":" & rend
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(rg)
ActiveChart.ChartType = xlBarStacked
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = l1
ActiveChart.Axes(xlValue).MaximumScale = l2
ActiveChart.Axes(xlValue).Select
ActiveSheet.ChartObjects(1).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Interior.ColorIndex = xlNone
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=dt
End Sub
Sub loadfile(ifile)
cdir = CurDir()
qfile = "TEXT;" & cdir & "" & ifile
With ActiveSheet.QueryTables.Add(Connection:= _
qfile _
, Destination:=Range("$A$1")
.Name = ifile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
I am a beginner in VBA but I need to amend a VBA code from an old colleague
The purpose of the code is to
1) create a chart of all elements on the vertical axis) against a 24 hour time represented in seconds on the horizontal axis.
the problem is that
1) the chart get created ,but not all the elements on the vertical axis gets shown on the vertical axis.
it seems to skip a few elements .
I found a way of manually forcing it to show all elements by going to Menu - Format axis -> axis options -> interval between labels --> specify interval unit = 1.
But i would like to put this in the VBA code below this so that all rows on the y axis gets a row on my chart.
The VBA code is below
Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long
Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)
Function CmdToSTr(Cmd As Long) As String
Dim Buffer() As Byte
Dim StrLen As Long
If Cmd Then
StrLen = lstrlenW(Cmd) * 2
If StrLen Then
ReDim Buffer(0 To (StrLen - 1)) As Byte
CopyMemory Buffer(0), ByVal Cmd, StrLen
CmdToSTr = Buffer
End If
End If
End Function
Sub processinput(cmdline)
filepos = Application.Find("/e/", cmdline)
If Not IsError(filepos) Then
ifile = Mid(cmdline, filepos + 3)
loadfile (ifile)
Call createprocesscharts
ActiveWorkbook.Close True
End If
End Sub
Sub createprocesscharts()
Dim sets(2, 365) As Long
Dim limits(2, 365) As Long
Dim dates(365) As String
c = 1
r = 2
Sheets("Sheet1".Select
dt = Cells(r, 5)
sets(1, c) = r
limits(1, c) = Cells(r, 2)
While (Cells(r, 5) <> ""
If Cells(r, 5) <> dt Then
sets(2, c) = r - 1
limits(2, c) = Cells(r - 1, 2)
dates(c) = Format(Cells(r - 1, 5), "ddd, d mmm yyyy"
dt = Cells(r, 5)
c = c + 1
sets(1, c) = r
limits(1, c) = Cells(r, 2)
End If
r = r + 1
Wend
sets(2, c) = r - 1
limits(2, c) = Cells(r - 1, 2)
dates(c) = Format(Cells(r - 1, 5), "ddd, d mmm yyyy"
For i = 1 To c
Debug.Print sets(1, i) & " " & sets(2, i) & " " & limits(1, i) & " " & limits(2, i) & " " & dates(i)
Call makechart(sets(1, i), sets(2, i), dates(i), limits(1, i), limits(2, i))
Next
End Sub
Sub makechart(r1 As Long, r2 As Long, dt As String, l1 As Long, l2 As Long)
Sheets("Sheet1".Select
rstart = "$A$" & r1
rend = "$C$" & r2
rg = "'Sheet1'!" & rstart & ":" & rend
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(rg)
ActiveChart.ChartType = xlBarStacked
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MinimumScale = l1
ActiveChart.Axes(xlValue).MaximumScale = l2
ActiveChart.Axes(xlValue).Select
ActiveSheet.ChartObjects(1).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Interior.ColorIndex = xlNone
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=dt
End Sub
Sub loadfile(ifile)
cdir = CurDir()
qfile = "TEXT;" & cdir & "" & ifile
With ActiveSheet.QueryTables.Add(Connection:= _
qfile _
, Destination:=Range("$A$1")
.Name = ifile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub