-
Convert all files in a folder instead individual files
Hello All,
Can you help me solve the following problem.
I want to change a piece of code in the below VBA which converts .txt to excel file, but I want the code to do all files in the folder. Instead of selecting individual files.
Code:
'Open the file selected by the user
Workbooks.Open fullpath
ActiveSheet.Columns.AutoFit
'Construct graphical analysis
Dim ochart As Object, ochartObj As Object
Dim countryRow As Integer, lastrow As Integer
Set ochartObj = ActiveSheet.ChartObjects.Add(Top:=10, Left:=325, Width:=600, Height:=300)
Set ochart = ochartObj.Chart
ochart.ChartType = xlXYScatterSmoothNoMarkers
Set ochart = ActiveSheet.ChartObjects(1).Chart
ochart.SeriesCollection.Add source:=Range("B3:B2000")
ochart.SeriesCollection(1).XValues = Range("D3
2000")
ochart.SeriesCollection(1).Values = Range("B3:B2000")
ochart.Axes(xlCategory).HasTitle = True
ochart.Axes(xlCategory).AxisTitle.caption = "Displacement (mm)"
ochart.Axes(xlValue).HasTitle = True
ochart.Axes(xlValue).AxisTitle.caption = "Load (N)"
ochart.SeriesCollection(1).HasDataLabels = False
ochart.SeriesCollection(1).Name = ActiveSheet.Name
ochart.Legend.Delete
For countryRow = 2 To lastrow
If Cells(countryRow, 4) - Cells(countryRow, 3) < 0 Then
ochart.SeriesCollection(1).Points(countryRow - 1).MarkerStyle = xlMarkerStyleNone
ochart.SeriesCollection(1).Points(countryRow - 1).MarkerBackgroundColor = vbRed
ochart.SeriesCollection(1).Points(countryRow - 1).MarkerForegroundColor = vbRed
If Cells(countryRow, 3) / Cells(countryRow, 4) > 1.15 Then
ochart.SeriesCollection(1).Points(countryRow - 1).MarkerBackgroundColor = vbWhite
End If
End If
Next countryRow
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Location Where:=xlLocationAsNewSheet
'Save Copy
Dim oFD As FileDialog
Set oFD = Application.FileDialog(msoFileDialogSaveAs)
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules