Codigo

Sub ExportTablesAndChartsToWord()
Dim wdApp As Object

Dim wdDoc As Object
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim shp As Shape
Dim i As Integer
On Error Resume Next

Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0
Set wdDoc = wdApp.Documents.Add

wdApp.Visible = True
For Each ws In ThisWorkbook.Worksheets

For Each tbl In ws.ListObjects
Set rng = tbl.Range
rng.Copy
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.Paste
.InsertParagraphAfter
End With
Next tbl
For Each shp In ws.Shapes

If shp.Type = msoChart Then
shp.Copy
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.Paste
.InsertParagraphAfter
End With
End If
Next shp
Next ws
Set wdDoc = Nothing

Set wdApp = Nothing
End Sub
High-level Summary: The code exports tables and charts from an Excel
workbook to a Word document. It creates a new Word document, loops through
each worksheet in the Excel workbook, and copies the tables and charts to the
Word document.
Detailed Explanation:
1. The code declares variables for Word application (wdApp), Word document
(wdDoc), worksheet (ws), range (rng), table (tbl), shape (shp), and an integer (i).
2. The code uses error handling to check if a Word application is already open. If
it is, it sets the wdApp variable to the existing application. If not, it creates a new
Word application.
3. The code creates a new Word document and makes it visible.
4. The code starts a loop to iterate through each worksheet in the Excel
workbook.
5. Within the worksheet loop, the code starts another loop to iterate through each
table (ListObject) in the worksheet.
6. The code sets the range variable (rng) to the range of the current table.
7. The code copies the range to the clipboard.
8. The code pastes the copied table into the Word document using the
PasteExcelTable method. It specifies that the table should not be linked to Excel,
Word formatting should not be applied, and RTF (Rich Text Format) should not
be used.
9. The code adds a new paragraph in the Word document after pasting the table.
10. After the table loop, the code starts another loop to iterate through each shape
in the worksheet.
11. The code checks if the shape is a chart (msoChart).
12. If the shape is a chart, the code copies the chart to the clipboard.
13. The code pastes the copied chart into the Word document using the Paste
method.
14. The code adds a new paragraph in the Word document after pasting the chart.
15. After the shape loop, the code moves to the next worksheet in the Excel
workbook.
16. The code sets the wdDoc and wdApp variables to Nothing to release the
memory used by the Word document and application.
17. The code ends.

Sub ExportTablesAndChartsToWord()
Dim wdApp As Object

Dim wdDoc As Object
Dim ws As Worksheet
Dim rng As Range
Dim tbl As ListObject
Dim shp As Shape
Dim i As Integer
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Add

wdApp.Visible = True
For Each ws In ThisWorkbook.Worksheets

For Each tbl In ws.ListObjects
Set rng = tbl.Range
rng.Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
wdDoc.Paragraphs.Add
Next tbl
For Each shp In ws.Shapes

If shp.Type = msoChart Then
shp.Copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
wdDoc.Paragraphs.Add
End If
Next shp
Next ws
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
Otro
Sub ExportTableAndGraph()
Dim ws As Worksheet
Dim rng As Range
Dim chrt As Chart
Dim pic As Picture
Dim path As String
Set ws = ThisWorkbook.Sheets("Sheet1") 'Change to your sheet name

Set rng = ws.Range("A1:B10") 'Change to your range
Set chrt = ws.ChartObjects("Chart 1").Chart 'Change to your chart name
path = "C:\temp\" 'Change to your path
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Set pic = ws.Pictures.Paste
pic.Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 375
Selection.ShapeRange.Width = 500
Selection.ShapeRange.Top = 0
Selection.ShapeRange.Left = 0
pic.Cut
chrt.Paste
chrt.Export Filename:=path & "TableAndGraph.jpg", FilterName:="JPG"
End Sub
High-level Summary: The code exports a table and a chart from a specified
worksheet in an Excel workbook. It copies the range of cells, pastes it as a
picture, adjusts the size and position of the picture, cuts it, pastes the chart, and
then exports the chart as a JPG file to a specified path.
Detailed Explanation:
1. The code declares and initializes variables for the worksheet, range, chart,
picture, and path.
2. It sets the worksheet variable to the specified sheet in the workbook.
3. It sets the range variable to the specified range of cells in the worksheet.
4. It sets the chart variable to the specified chart in the worksheet.
5. It sets the path variable to the specified path where the exported file will be
saved.
6. The code copies the range of cells as a picture, using the xlScreen appearance
and xlPicture format.
7. It pastes the picture as a new picture object and assigns it to the picture
variable.
8. The picture is selected and its shape range properties are adjusted. The aspect
ratio is unlocked, height and width are set, and the position is set to the top-left
corner of the worksheet.
9. The picture is cut from its current location.
10. The chart is selected and the picture is pasted onto it.
11. The chart is exported as a JPG file to the specified path, with the filename
'TableAndGraph.jpg' and the JPG filter.

Codigo

Uploaded by

Copyright:

Available Formats

Codigo

Uploaded by

Document Information

Original Description:

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Codigo

Uploaded by

Copyright:

Available Formats

Sub ExportTablesAndChartsToWord()

Dim wdApp As Object

On Error Resume Next

Set wdDoc = wdApp.Documents.Add

For Each ws In ThisWorkbook.Worksheets

For Each shp In ws.Shapes

Set wdDoc = Nothing

3. The code creates a new Word document and makes it visible.

11. The code checks if the shape is a chart (msoChart).

17. The code ends.

Dim wdApp As Object

Set wdDoc = wdApp.Documents.Add

For Each ws In ThisWorkbook.Worksheets

For Each shp In ws.Shapes

Set ws = ThisWorkbook.Sheets("Sheet1") 'Change to your sheet name

rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

You might also like

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.