- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 118
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-22
              
|
回復 3# dechiuan999
試試看- Sub aa()
-
- '貨物存放處統計圖表
-
- Dim mRng As Range
- Dim mRng1 As Range
- Dim mRng2 As Range
- Dim mRng3 As Range
- Dim mRng4 As Range
- Dim mTotal%, mRow$
- Dim oldmonth
- Dim mSht1 As Worksheet
- Dim mChart As ChartObject
- Dim mCol%, sumTotal As Long
-
- Application.ScreenUpdating = False
-
- Set mSht1 = Worksheets("當月統計表及圖表")
- With mSht1
- mCol = .Range("a16").End(xlToRight).Column
- Set mRng = .Range("a17").Resize(5, mCol)
- Set mRng1 = .Range("b25").Resize(5, .Range("b25").End(xlToRight).Column - 1)
- Set mRng2 = Union(mRng, mRng1)
- Set mRng3 = .Range("a1").Resize(14, mCol)
- End With
-
- oldmonth = Month(Date)
- If oldmonth = "1" Then
- oldmonth = "12"
- Else
- oldmonth = oldmonth - 1
- End If
- Call changeMonth(oldmonth)
- Application.ScreenUpdating = False
-
- Set mChart = mSht1.ChartObjects.Add(mRng3.Left, mRng3.Top, mRng3.Width, mRng3.Height)
- With mChart
- .Name = "各關區貨物存放處所統計表"
- End With
-
- mTotal = Application.WorksheetFunction.Max(mRng2)
- Select Case mTotal
-
- Case 1 To 50
- mTotal = "50"
- Case 51 To 100
- mTotal = "100"
- Case 101 To 150
- mTotal = "150"
- Case 151 To 200
- mTotal = "200"
- Case 201 To 250
- mTotal = "250"
- Case 251 To 300
- mTotal = "300"
- Case 301 To 350
- mTotal = "350"
- Case 351 To 400
- mTotal = "400"
- Case 401 To 450
- mTotal = "450"
- Case 451 To 500
- mTotal = "500"
- End Select
-
- Set mRng4 = mSht1.Rows(24).Find(what:="總計 ：", after:=mSht1.Range("a24"), LookIn:=xlValues, SearchDirection:=xlPrevious)
- If Not mRng4 Is Nothing Then
- sumTotal = mRng4.Offset(6).Value
- End If
-
- With mChart.Chart
- .SetSourceData Source:=mRng2, PlotBy:=xlRows
- '個別設置數列範圍
- .SeriesCollection(1).XValues = _
- "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
- .SeriesCollection(1).Values = _
- "=(當月統計表及圖表!R18C2:R18C20,當月統計表及圖表!R26C2:R26C6)"
- .SeriesCollection(1).Name = "=當月統計表及圖表!R18C1"
- .SeriesCollection(2).XValues = _
- "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
- .SeriesCollection(2).Values = _
- "=(當月統計表及圖表!R19C2:R19C20,當月統計表及圖表!R27C2:R27C6)"
- .SeriesCollection(2).Name = "=當月統計表及圖表!R19C1"
- .SeriesCollection(3).XValues = _
- "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
- .SeriesCollection(3).Values = _
- "=(當月統計表及圖表!R20C2:R20C20,當月統計表及圖表!R28C2:R28C6)"
- .SeriesCollection(3).Name = "=當月統計表及圖表!R20C1"
- .SeriesCollection(4).XValues = _
- "=(當月統計表及圖表!R17C2:R17C20,當月統計表及圖表!R25C2:R25C6)"
- .SeriesCollection(4).Values = _
- "=(當月統計表及圖表!R21C2:R21C20,當月統計表及圖表!R29C2:R29C6)"
- .SeriesCollection(4).Name = "=當月統計表及圖表!R21C1"
- '刪除錯誤數列
- Do Until .SeriesCollection.Count = 4
- .SeriesCollection(5).Delete
- Loop
- .Location Where:=xlLocationAsObject, Name:="當月統計表及圖表"
- .HasTitle = True
- .ChartType = xlColumnClustered
- .HasLegend = True
- .ApplyDataLabels xlDataLabelsShowValue
- .Axes(xlCategory).TickLabels.Orientation = xlHorizontal
- .ChartTitle.Characters.Text = " " & oldmonth & " 月份各關區貨物存放處所統計表 (" & sumTotal & " 份)"
- .ChartTitle.Font.Bold = False
- .ChartTitle.Font.Size = 12
- With .Axes(Type:=xlValue)
- .HasTitle = True
- .AxisTitle.Text = "貨物存放處所"
- .AxisTitle.Orientation = xlVertical
- .MaximumScale = mTotal
- End With
- .ChartArea.Font.Size = 8
- .ChartTitle.Font.Size = 10
- End With
-
- Application.ScreenUpdating = True
-
- Set mRng = Nothing
- Set mRng1 = Nothing
- Set mRng2 = Nothing
- Set mRng3 = Nothing
- Set mChart = Nothing
- End Sub
|
|
發表於 2012-4-4 19:24
| 
