Ответ 1
Следующий код создает файл PDF для каждого Sheet (исключая любой Worksheet) в ThisWorkbook:
Sub Charts_Export()
Const kPath As String = "D:\@D_Trash\SO Questions\Output\#Name.pdf" 'Update as required
Dim oSht As Object, sPath As String
With ThisWorkbook
For Each oSht In .Sheets
With oSht
If oSht.Type <> xlWorksheet Then
sPath = Replace(kPath, "#Name", .Name) 'Update as required
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If: End With: Next: End With
End Sub
Когда PDF файлы открыты, одновременно нажмите Shift + Ctrl + Y, чтобы активировать опцию Read Out Loud в pdf. Затем одновременно нажмите Shift + Ctrl + V, чтобы прочитать AlternativeText.
Предыдущий код, который использует ту же часть, опубликованную OP, экспортировал диаграммы в виде файлов PDF, включая Alternative text в каждом.
Похоже, это указывает на то, что проблема может быть связана с методом, используемым для добавления AlternativeText к Chart. Я не смог найти способ добавить AlternativeText к Chart после того, как он был перемещен как Sheet, поэтому необходимо добавить AlternativeText перед перемещением Chart в Sheet, когда Chart все еще является объектом (Shape) на листе.
Используйте этот метод, чтобы добавить AlternativeText к каждому Chart перед перемещением его на лист ".
Private Sub Charts_Add_AlternativeText()
Const kAltTxt As String = "This is a test of the Alt Text in graph [#Name]" 'Update as required
Dim ws As Worksheet
Dim co As ChartObject
Set ws = ThisWorkbook.Worksheets("DATA") 'Update as required
For Each co In ws.ChartObjects
co.ShapeRange.AlternativeText = Replace(kAltTxt, "#Name", co.Name) 'Update as required
Next
End Sub
Или используйте этот метод для добавления AlternativeText на каждый лист Chart.
Private Sub Charts_Add_AlternativeText()
Const kWsName As String = "!Temp"
Const kAltTxt As String = "This is a test of the Alt Text in graph [#Name]" 'Update as required
Dim wb As Workbook, ws As Worksheet
Dim oSht As Object, sp As Shape
Dim sChName As String, bIdx As Byte
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Application.Calculation = xlCalculationManual
End With
Set wb = ThisWorkbook
With wb
Rem Add Temp Worksheet
On Error Resume Next
.Worksheets(kWsName).Delete
On Error GoTo 0
Set ws = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = kWsName
Rem Work with Chart Sheets
For Each oSht In .Sheets
With oSht
If oSht.Type <> xlWorksheet Then
Rem Move Chart to Temp Worksheet
bIdx = .Index
sChName = .Name
.Location Where:=xlLocationAsObject, Name:=kWsName
Set sp = ws.Shapes(1)
With sp
Rem Add AlternativeText to Shape (Chart)
.AlternativeText = Replace(kAltTxt, "#Name", sChName) 'Update as required
Rem Move Chart to Chart Sheet
.Chart.Location Where:=xlLocationAsNewSheet, Name:=sChName
wb.Sheets(sChName).Move Before:=wb.Sheets(bIdx)
End With: End If: End With: Next: End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
.Application.Calculation = xlCalculationAutomatic
End With
End Sub