VBAを使用してExcelで生成されたグラフが約500あり、それらをpdfにエクスポートする必要があります。これらのグラフには、視覚障害者がアクセスできるようにする代替テキストがあります。 VBA(ExportAsFixedFormat)を使用してPDFを生成すると、PDFで代替テキストが失われます。 pythonまたはRにExcelからpdfにグラフを変換し、代替テキストを保持するためのコードはありますか?
グラフを手動でPDFとして保存すると、代替テキストがグラフとともにPDFファイルに保存されます。ただし、グラフが多すぎるため、これを自動的に実行できると便利です。
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
上記のVBAのコードはPDFの作成には役立ちますが、代替テキストは保持されません。
次のコードは、Sheet
の各Worksheet
(ThisWorkbook
を除く)ごとにPDFファイルを生成します。
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 同時にPDFのRead Out Loud
オプションをアクティブにします。次に押す Shift + Ctrl + V AlternativeText
を同時に読み取る
OPによって公開されたものと同じ部分を使用する以前のコードは、チャートをそれぞれAlternative text
を含むpdfファイルとしてエクスポートしました。
これは、問題が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