엑셀에서 워드로 붙여넣은 차트의 파일 크기 줄이기

엑셀에서 워드로 붙여넣은 차트의 파일 크기 줄이기

저는 엑셀 문서에서 일부 차트와 데이터를 워드 문서로 복사하여 보고서를 작성하고 있습니다.컨트롤에 에 콘츠컨붙에여중이는로므넣롤트텐로므중을 사용합니다.ChartObject.CopyPicture과 륭히로ContentControl.Range.Paste말로 하면이 작업은 반복적으로 수행됩니다.

Set ws = ThisWorkbook.Worksheets("Charts")
With ws
For Each cc In wordDocument.ContentControls

    If cc.Range.InlineShapes.Count > 0 Then
        scaleHeight = cc.Range.InlineShapes(1).scaleHeight
        scaleWidth = cc.Range.InlineShapes(1).scaleWidth
        cc.Range.InlineShapes(1).Delete
        .ChartObjects(cc.Tag).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        cc.Range.Paste
        cc.Range.InlineShapes(1).scaleHeight = scaleHeight
        cc.Range.InlineShapes(1).scaleWidth = scaleWidth
    ElseIf ...
Next cc
End With

Office 2007을 사용하여 이러한 보고서를 생성하면 약 6MB의 파일이 생성되지만 Office 2010에서 동일한 워크시트와 문서를 사용하여 생성하면 약 10배의 파일이 생성됩니다.

docx의 압축을 푼 후, 저는 추가 크기가 VBA를 사용하여 붙여넣은 차트에 해당하는 emf 파일에서 나온다는 것을 발견했습니다.이전에는 360-900KB 범위였지만 5-18MB였습니다.그리고 그래픽이 눈에 띄게 더 나은 것은 아닙니다.

게다가, 그것은 차트 스타일과 관련이 있는 것 같습니다.저는 새로운 스프레드시트를 만들고 7개의 데이터 포인트와 해당하는 2D 원형 차트를 삽입했습니다.기본 스타일에서는 79KBemf로 복사되고 스타일 26에서는 10MBemf로 복사됩니다.Office 2007을 사용할 때 차트가 700KBemf로 복사되었습니다.코드는 다음과 같습니다.

Sub CopyAndPaste()
    ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub

형식으로 사진을 복사할 수 있습니다.xlBitmap그리고 그것은 다소 작지만 Office 2007에서 생성된 emf보다 크고 눈에 띄게 품질이 떨어집니다.파일 크기를 줄이기 위한 다른 옵션이 있습니까?이상적으로는 Office 2007을 사용했을 때와 동일한 해상도의 파일을 차트용으로 제작하고 싶습니다.스프레드시트의 차트를 수정하지 않고 VBA만 사용하는 방법이 있습니까?문서를 연결하지 않고 객체로 쉽게 복사할 수 있는 방법은 무엇입니까?

"그것은 오래된 코드입니다, 선생님, 하지만 그것은 확인됩니다."

오래된 질문이고 훨씬 더 오래된 (가능한) 해결책이 있습니다. .EMF 파일을 zip으로 압축하여 .EMZ로 압축할 수 있습니다.이렇게 하면 이미지 품질을 유지하면서 파일 크기가 줄어듭니다.

VB6에서 사용한 코드는 아래와 같습니다.함수 이름을 영어로 변경했지만 모든 주석은 포르투갈어로 유지했습니다.

Option Explicit

' Declaração das interfaces com a ZLIB
Private Declare Function gzopen     Lib "zlib.dll" (ByVal file As String, ByVal mode As String) As Long
Private Declare Function gzwrite    Lib "zlib.dll" (ByVal file As Long, ByRef uncompr As Byte, ByVal uncomprLen As Long) As Long
Private Declare Function gzclose    Lib "zlib.dll" (ByVal file As Long) As Long
Private Declare Function Compress   Lib "zlib.dll" Alias "compress" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long) As Long
Private Declare Function Uncompress Lib "zlib.dll" Alias "uncompress" (ByRef dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long) As Long

' Ler o conteúdo de um arquivo
Public Function FileRead(ByVal strNomeArquivo As String) As Byte()

    Dim intHandle     As Integer
    Dim lngTamanho    As Long
    Dim bytConteudo() As Byte

    On Error GoTo FileReadError

    ' Abrir o documento indicado
    intHandle = FreeFile
    Open strNomeArquivo For Binary Access Read As intHandle

    ' Obter o tamanho do arquivo
    lngTamanho = LOF(intHandle)
    ReDim bytConteudo(lngTamanho)

    ' Obter o conteúdo e liberar o arquivo
    Get intHandle, , bytConteudo()
    Close intHandle

    FileRead = bytConteudo

    On Error GoTo 0
    Exit Function

FileReadError:

    objLogger.GravarEvento "modZLib.FileRead: " & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.Erro

End Function

'Compactar um arquivo com o padrão gzip
Public Sub FileCompress(ByVal strArquivoOrigem As String, ByVal strArquivoDestino As String)

    Dim gzFile        As Long
    Dim bytConteudo() As Byte

    On Error GoTo FileCompressError

    ' Ler o conteúdo do arquivo
    bytConteudo = FileRead(strArquivoOrigem)

    ' Compactar o conteúdo
    gzFile = gzopen(strArquivoDestino, "wb")
    gzwrite gzFile, bytConteudo(0), UBound(bytConteudo)
    gzclose gzFile

    On Error GoTo 0
    Exit Sub

FileCompressError:

    objLogger.GravarEvento "modZLib.FileCompress:" & Err.Description & " (" & Err.Number & " - " & Err.Source & ")", logTipoEvento.Erro

End Sub

전에도 이런 일을 다뤄본 적이 있습니다

사용하는 대신

Document.Range.Paste

사용해 보기

Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture

또는

Document.Range.PasteSpecial DataType:= wdPasteShape

내장된 Excel 개체와 반대로 차트를 그림 또는 도면으로 붙여넣습니다.

"Paste Special.."을 사용하는 것과 같습니다.메뉴에서.

다른 데이터 유형을 사용할 수 있습니다.

http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx

.emf 파일의 크기가 잘못 조정되었기 때문일 수 있습니다.PNG를 사용하면 크기 문제가 해결될 수 있지만(위의 주석에서 언급한 바와 같이) 벡터 이미지가 아니기 때문에 문제가 될 수 있습니다.

사진 추가를 사용하여 파일에 이미지를 추가하는 경우 다음 페이지에서는 사용 중인 기본값에서 크기를 변경하고 파일 크기를 줄일 수 있는 솔루션을 보여 줍니다.그래서 당신의 문제를 해결할 수도 있습니다.

http://social.msdn.microsoft.com/Forums/en-US/f1c9c753-77fd-4c17-9ca8-02908debca5d/emf-file-added-using-the-addpicture-method-looks-bigger-in-excel-20072010-vs-excel-2003?forum=exceldev

언급URL : https://stackoverflow.com/questions/23807428/reduce-file-size-for-charts-pasted-from-excel-into-word