EDITED
Если у вас, ребята, есть ссылка, которая может помочь в решении этой проблемы, я бы очень хотел ее прочитать, потому что до сих пор я не видел ничего очень полезного.
В доступе я пытаюсь экспортировать произвольные данные в Excel, создать несколько диаграмм (сейчас просто работаю с круговой диаграммой), отформатировать эти диаграммы и затем отправить их на пустой (Chart) лист. Пока я экспортировал данные и могу создавать диаграммы, я просто не знаю, как их отформатировать.
Я хочу сделать форматирование, чтобы избавиться от легенды, поместить метки данных с именем, значением и процентом и переместить их на лист «Диаграмма».
Редактировать Теперь я могу избавиться от легенды, а также вставить метки данных с именем, значением и процентом. Я все еще застрял при перемещении объекта Chart на новый лист с кодом внизу.
Я также пытался записать макрос в Excel, слегка отредактировать его, а затем переместить его для доступа, но я продолжаю выдавать ошибку, обычно с ошибкой, подобной «У этого объекта нет этого метода». Ниже я приведу тестовую таблицу, которую я могу получить, и порядок создания круговой диаграммы.
Код:
Function Excel_Export_Two_Column()
Dim db As DAO.Database, rs As DAO.Recordset
Dim WBO As Object, WSO As Object, WSO2 As Object, XLO As Object, oChart As Object
Dim x As Long, y As Long, z As Integer, strTab As String, strcompany As String
Dim endTable As Long
Dim tempName As String, tempNum1 As Long, tempNum2 As Long, totalEnd As Long
z = 1
Set db = CurrentDb()
Set rs = db.OpenRecordset("QRY2Col")
Set XLO = CreateObject("Excel.Application")
XLO.Application.Workbooks.Add
Set WBO = XLO.Application.ActiveWorkbook
Set WSO = WBO.Worksheets(1)
Set WSO2 = WBO.Worksheets(2)
WSO.Name = Left("export", 31)
For y = 0 To rs.Fields.Count - 1
WSO.Cells(1, 1) = "Num"
WSO.Cells(1, y + 2) = rs(y).Name
Next y
x = 1
Do While Not rs.EOF()
x = x + 1
WSO.Cells(x, 1) = x - 1
For y = 0 To rs.Fields.Count - 1
WSO.Cells(x, y + 2) = Trim(rs(y))
Next y
rs.MoveNext
DoEvents
Loop
WSO.Cells.Rows(1).AutoFilter
WSO.Application.Cells.Select
WSO.Cells.EntireColumn.AutoFit
x = 1
Do While WSO.Cells(x, 1) <> ""
x = x + 1
Loop
endTable = x - 1
WSO2.Cells(1, 1) = "Name"
WSO2.Cells(1, 2) = "Num"
totalEnd = 2
For x = 2 To endTable
If (WSO.Cells(x, 2) <> "") Then
tempName = WSO.Cells(x, 2)
tempNum1 = WSO.Cells(x, 3)
For y = 2 To totalEnd
If (WSO2.Cells(y, 1) = tempName) Then
tempNum2 = WSO2.Cells(y, 2)
WSO2.Cells(y, 2) = tempNum1 + tempNum2
Exit For
ElseIf (y = totalEnd) Then
WSO2.Cells(y, 1) = tempName
WSO2.Cells(y, 2) = tempNum1
totalEnd = totalEnd + 1
End If
Next y
End If
Next x
Set oChart = WSO2.ChartObjects.Add(500, 100, 500, 300).Chart
oChart.SetSourceData Source:=WSO2.Range("A1").Resize(totalEnd - 1, 2)
oChart.ChartType = 5
strcompany = "Export"
If Dir(CurrentProject.Path & "\COLA_AR_" & Format(Date, "yyyymm") & "_XXX_" & strcompany & ".xlsx") <> "" Then
Kill CurrentProject.Path & "\COLA_AR_" & Format(Date, "yyyymm") & "_XXX_" & strcompany & ".xlsx"
End If
Call WBO.SaveAs(CurrentProject.Path & "\COLA_AR_" & Format(Date, "yyyymm") & "_test_2_Col.xlsx")
WBO.Close savechanges:=True
Set WBO = Nothing
XLO.Application.Quit
Set XLO = Nothing
rs.Close
db.Close
End Function
Таблица: обратите внимание, что эта таблица находится в запросе (с именем «QRY2Col») в Access
Field1 Field2
CTOD 64646515
BFTBC2 6656532
WTOW 451512355
DT3 684321818
STC2 652553548
BFTBC2 12
DT3 84954987
ATCR 99999999
CTOD 64185435
BFTBC2 321569846
STC2 6543518
STC2 3518684
ATCR 35481354
Код для меток данных
Set oChart = WSO2.ChartObjects.Add(500, 100, 500, 300).Chart
oChart.SetSourceData Source:=WSO2.Range("A1").Resize(totalEnd - 1, 2)
' Number corresponds to a pie chart
oChart.ChartType = 5
' Adds data Labels
oChart.SeriesCollection(1).HasDataLabels = True
' Format chart
oChart.SeriesCollection(1).DataLabels.ShowCategoryName = True
oChart.SeriesCollection(1).DataLabels.ShowPercentage = True
oChart.SeriesCollection(1).HasLeaderLines = True
oChart.Legend.Delete
Попытка кода для перемещения графика
Ниже приведен пример того, что я записал (отредактировал, добавив «oChart»), но это все равно не работает. Выделенная проблема - это «xlLocationAsNewSheet», а VBA говорит, что «Переменная не определена».
oChart.Location Where:=xlLocationAsNewSheet
Спасибо,
Джесси Смотермон