VBA自动生成图表

'//此VBA为Excel宏语言'

1  
  2 
  3 'Attribute VB_Name = "模块1"
  4 Sub 制图表_NBR_G()
  5 'Attribute 制图表_NBR_G.VB_ProcData.VB_Invoke_Func = " \n14"
  6 '获取当前文件目录
  7 Dim CurPath
  8 CurPath = ActiveWorkbook.Path
  9 ' 制图表_NBR_G 宏
 10 
 11 '忽略相关弹窗信息
 12 Application.DisplayAlerts = False
 13 ' 获取今天的时间
 14 Dim DateOfToday As String
 15 DateOfToday = Format$(Date, "yyyymmdd")
 16 'DateOfToday = 20161105
 17 '打开文本取数据
 18 Const ForReading = 1, ForWriting = 2, ForAppending = 8
 19 '格式:路由器IP 店铺编号 型号
 20 Dim fso, file1, line, params, ip, number, mode
 21 Set fso = CreateObject("Scripting.FileSystemObject")
 22 Set file1 = fso.OpenTextFile(CurPath & "\NBR_G.txt", ForReading, False)
 23 '循环写每一列数据
 24 Do While file1.AtEndOfStream <> True
 25 '读取一行数据
 26 line = file1.ReadLine
 27 '格式:路由器IP 店铺编号 型号
 28 params = Split(line)
 29 '获取IP地址
 30 ip = params(0)
 31 '店铺编号
 32 number = params(1)
 33 '获取设备型号
 34 mode = params(2)
 35 
 36 '判断同一型号设备添加数据结束,制图标
 37 If number = "END" Then
 38 '删除掉多余字符串
 39 Cells.Replace What:="Number of active flows:", Replacement:="", LookAt:= _
 40 xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 41 ReplaceFormat:=False
 42 
 43 If mode = "1300G" Then
 44 '调整数据格式
 45 Range("B2:AI49").Select
 46 Selection.NumberFormatLocal = "0"
 47 '选择区域生成图表
 48 Range("A1:AI49").Select
 49 ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 50 ActiveChart.SetSourceData Source:=Range("data!$A$1:$AI$49")
 51 End If
 52 
 53 If mode = "1000G" Then
 54 '调整数据格式
 55 Range("B2:I49").Select
 56 Selection.NumberFormatLocal = "0"
 57 '选择区域生成图表
 58 Range("A1:I49").Select
 59 ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 60 ActiveChart.SetSourceData Source:=Range("data!$A$1:$I$49")
 61 End If
 62 
 63 If mode = "1500G" Then
 64 '调整数据格式
 65 Range("B2:B49").Select
 66 Selection.NumberFormatLocal = "0"
 67 '选择区域生成图表
 68 Range("A1:B49").Select
 69 ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 70 ActiveChart.SetSourceData Source:=Range("data!$A$1:$B$49")
 71 End If
 72 
 73 If mode = "2000G" Then
 74 '调整数据格式
 75 Range("B2:C49").Select
 76 Selection.NumberFormatLocal = "0"
 77 '选择区域生成图表
 78 Range("A1:C49").Select
 79 ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
 80 ActiveChart.SetSourceData Source:=Range("data!$A$1:$C$49")
 81 End If
 82 
 83 ActiveChart.Axes(xlCategory).Select
 84 '调整图表横坐标度量值
 85 ActiveChart.Axes(xlCategory).MaximumScale = 1
 86 ActiveChart.Axes(xlCategory).MajorUnit = 0.05
 87 '调整图表纵坐标起始值
 88 ActiveChart.Axes(xlValue).MinimumScale = 0
 89 ActiveChart.ClearToMatchStyle
 90 ActiveChart.ChartStyle = 245
 91 '修改图表title
 92 ActiveChart.ChartTitle.Select
 93 Selection.Format.TextFrame2.TextRange.Characters.Text = mode & "-" & DateOfToday & "-Report"
 94 ActiveChart.ChartArea.Select
 95 '移动到新的chart里
 96 ActiveChart.Location Where:=xlLocationAsNewSheet
 97 End If
 98 
 99 
100 If ip <> "IP" Then
101 '激活data sheet
102 Worksheets("data").Activate
103 '从文本读取数据写到B2
104 
105 With ActiveSheet.QueryTables.Add(Connection:= _
106 "TEXT;" & CurPath & "\temp\R_" & ip & "_" & DateOfToday & ".txt", Destination:= _
107 Range("$B$2"))
108 .Name = "R_" & ip & "_" & DateOfToday & ""
109 .FieldNames = True
110 .RowNumbers = False
111 .FillAdjacentFormulas = False
112 .PreserveFormatting = True
113 .RefreshOnFileOpen = False
114 .RefreshStyle = xlInsertDeleteCells
115 .SavePassword = False
116 .SaveData = True
117 .AdjustColumnWidth = False
118 .RefreshPeriod = 0
119 .TextFilePromptOnRefresh = False
120 .TextFilePlatform = 936
121 .TextFileStartRow = 1
122 .TextFileParseType = xlDelimited
123 .TextFileTextQualifier = xlTextQualifierDoubleQuote
124 .TextFileConsecutiveDelimiter = False
125 .TextFileTabDelimiter = True
126 .TextFileSemicolonDelimiter = False
127 .TextFileCommaDelimiter = False
128 .TextFileSpaceDelimiter = False
129 .TextFileColumnDataTypes = Array(1, 1, 1, 1)
130 .TextFileTrailingMinusNumbers = True
131 .Refresh BackgroundQuery:=False
132 End With
133 '将店铺编号写到B1
134 Range("B1").Select
135 ActiveCell.FormulaR1C1 = number
136 End If
137 
138 Loop
139 '将生成图标另存为本目录下的excel
140 ChDir CurPath
141 ActiveWorkbook.SaveAs Filename:=CurPath & "\NBR_G_Report_" & DateOfToday & ".xlsx", _
142 FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
143 
144 End Sub
145 
146