Marco convert định dạng emf sang png?

mynukeviet

Thành viên mới
Chào các bạn, ứng dụng đọc file word của mình hiện tại không hooix trợ file ảnh emf nên khi đọc gây lỗi, giải pháp của mình là sử dụng marco để chuyển tất cả ảnh emf sang png (hoặc jpeg) nhưng khổ là kiến thức về marco hạn hẹp nên không tự viết được.
Mình gửi file word,

Tức là mình muốn chạy marco cái là ảnh tự thay ngay trong file word


File word này có chứa 1 hình ảnh emf bạn nhé,
Mong mọi người giúp đỡ!

INPUT: word chứa ảnh emf
OUTPUT: word, thay thế bằng ảnh jpg
Lý do: word hiện tại không hỗ trợ file ảnh emf nên muốn convert sang jpg.

Lời bàn: Nếu một máy tính không đọc được emf thì liệu nó có thể convert sang jpg được hay không? Nguyên lý của convert là phải hiểu A là gì rồi mới chuyển A thành B. (Admin: tuhocvba)
 

tuhocvba

Administrator
Thành viên BQT
Không biết là ứng dụng như nào thì không đọc được nhỉ. Trên ứng dụng của mình thì hiện như này, không biết như này là đọc được hay không đọc được.
Bạn cần đăng nhập để thấy hình ảnh
 

Euler

Biên Tập Viên
Không biết file ảnh dán trong word là loại ảnh gì. Nhưng khi save .html thì được file ảnh .png
Vậy bạn có thể lưu file word thành .html , rồi sau đó mở file .html copy toàn bộ nội dung, paste vào một file word khác, liệu có giải quyết được vấn đề không?
Hiện tại chưa biết loại ảnh emf là loại ảnh như nào, nhưng nếu là code xóa ảnh trong word thì có thể tham khảo code sau:
Mã:
Sub DitchPictures()
Dim objPic As InlineShape
For Each objPic In ActiveDocument.InlineShapes
objPic.Delete
Next objPic
End Sub
 

tuhocvba

Administrator
Thành viên BQT
Step 1: Xuất các shape có trong word ra ảnh jpg.
File excel macro để chung thư mục với file word.
Mã:
Sub gen_Files()

Dim WdApp As Word.Application, Doc As Word.Document, fPath As String
Dim i As Long
Dim cht As Chart, obj As ChartObject
Dim Ws As Worksheet
Dim myFn As String
Dim shp As InlineShape

Set Ws = ActiveSheet

fPath = ThisWorkbook.Path & Application.PathSeparator & "Thu.docx"
If fPath = "" Or Dir(fPath) = "" Then MsgBox "Invalid file path.": Exit Sub

Set WdApp = New Word.Application
WdApp.Visible = True
Set Doc = WdApp.Documents.Open(fPath)
Doc.SaveAs2 ThisWorkbook.Path & "\New.docx", FileFormat:=12

For i = 1 To Doc.InlineShapes.Count
    Set shp = Doc.InlineShapes(i)
    shp.Range.CopyAsPicture
    Set obj = Ws.ChartObjects.Add(Range("i1").Left, 0, shp.Width, shp.Height)
    myFn = ThisWorkbook.Path & Application.PathSeparator & i & ".jpg"
    With obj.Chart
        .Paste
        .Export myFn
    End With
    obj.Delete
Next i

'Save the file and done
Doc.Save
Doc.Close
WdApp.Quit

End Sub
Macro sẽ copy file word, tạo ra file word khác là New.docx (mục đích: không tác động trực tiếp vào file word gốc ban đầu), các ảnh có trong word, paste vào cells I1 trên excel, từ đó xuất ra các file ảnh có tên 1.jpg, 2.jpg,.. cất chung thư mục với file word và excel.

Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


File macro excel để xuất ảnh, tôi đã tạo, bạn ấn ALT +F11 tùy ý sửa code, chỉnh sửa lại đường link lưu trữ ảnh tùy ý sao cho phù hợp với ý đồ của bạn.
File:

Nguồn:

Step 2: Thay đổi ảnh trên word bằng các bức ảnh jpg.
Trên file word cần thay đổi ảnh, ấn Alt+F11, tạo module mới rồi dán code dưới đây vào và chạy.
Code này thay thế một file ảnh. Tùy ý sửa code để thay đổi toàn bộ số lượng ảnh mà bạn có.

Mã:
Sub replaceImage()

    Dim originalImage As InlineShape
    Dim newImage As InlineShape

    Set originalImage = ActiveDocument.InlineShapes(1)

    Dim imageControl As ContentControl

    If originalImage.Range.ParentContentControl Is Nothing Then
        Set imageControl = ActiveDocument.ContentControls.Add(wdContentControlPicture, originalImage.Range)
    Else
        Set imageControl = originalImage.Range.ParentContentControl
    End If

    Dim imageW As Long
    Dim imageH As Long
    imageW = originalImage.Width
    imageH = originalImage.Height

    originalImage.Delete

    Dim imagePath As String
    imagePath = "C:\Users\SlowLearner\Pictures\Temp\testImage.jpg"
    ActiveDocument.InlineShapes.AddPicture imagePath, False, True, imageControl.Range

    With imageControl.Range.InlineShapes(1)
        .Height = imageH
        .Width = imageW
    End With

End Sub
Phần khoanh đỏ, tôi test thử và thấy ảnh đã thay đổi.
Bạn cần đăng nhập để thấy hình ảnh

Nguồn:
 
Top