Lấy ảnh trong file Excel bằng "Save as Picture..."

[htin1997]

Xin chào mọi người,

Như tiêu đề, mình không thể Record được thao tác "Save as Picture...", Google cũng không giúp được.



Vì vậy cho nên đã tìm đến sendkeys để thực hiện. Tuy nhiên, yêu cầu là chỉ lưu hết ảnh vào ổ đĩa, không muốn có shapes trong đó.
Code trong file có 2 dạng:
1. Layanh dùng phím {TAB} để chuyển shape để save, có dùng IF để phân biệt giữa ảnh và shape nhưng không hiểu sao code vẫn lấy luôn shape ra để save as.
2. Layanh1 dung phương thức select. Code này lại gặp trường hợp không thể đổi ảnh được, xuất có 1 ảnh xuất mãi.
Không có code nào đạt yêu cầu cả. Hiện tại không biết sai sót chỗ nào, nhờ mọi người giúp đỡ.

 

[Nhattanktnn]

Xin chào mọi người,

Như tiêu đề, mình không thể Record được thao tác "Save as Picture...", Google cũng không giúp được.

View attachment 277245

Vì vậy cho nên đã tìm đến sendkeys để thực hiện. Tuy nhiên, yêu cầu là chỉ lưu hết ảnh vào ổ đĩa, không muốn có shapes trong đó.
Code trong file có 2 dạng:
1. Layanh dùng phím {TAB} để chuyển shape để save, có dùng IF để phân biệt giữa ảnh và shape nhưng không hiểu sao code vẫn lấy luôn shape ra để save as.
2. Layanh1 dung phương thức select. Code này lại gặp trường hợp không thể đổi ảnh được, xuất có 1 ảnh xuất mãi.
Không có code nào đạt yêu cầu cả. Hiện tại không biết sai sót chỗ nào, nhờ mọi người giúp đỡ.

Bạn thử xem

Option Explicit

Sub SaveShapeAsPicture(ByVal ActiveShape As Shape)
Dim cht As ChartObject
Application.ScreenUpdating = False
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)
    
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste
  cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & ActiveShape.Name & ".png"
  cht.Delete
Application.ScreenUpdating = True
End Sub

Sub Layanh3()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If InStr(1, sh.Name, "picture", 1) Then
        SaveShapeAsPicture sh
    End If
Next
End Sub

 

[htin1997]

Bạn thử xem

Option Explicit

Sub SaveShapeAsPicture(ByVal ActiveShape As Shape)
Dim cht As ChartObject
Application.ScreenUpdating = False
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)
   
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste
  cht.Chart.Export Environ("USERPROFILE") & "\Desktop\" & ActiveShape.Name & ".png"
  cht.Delete
Application.ScreenUpdating = True
End Sub

Sub Layanh3()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If InStr(1, sh.Name, "picture", 1) Then
        SaveShapeAsPicture sh
    End If
Next
End Sub

Cám ơn bác rất nhiều, dạng này thì hiện tại hôm trước cháu có tìm trên diễn đàn đã sử dụng được. Tuy nhiên phát sinh 1 vấn đề là lâu lâu có 1 ảnh bị mất tỉ lệ.

 

[Nhattanktnn]

Cám ơn bác rất nhiều, dạng này thì hiện tại hôm trước cháu có tìm trên diễn đàn đã sử dụng được. Tuy nhiên phát sinh 1 vấn đề là lâu lâu có 1 ảnh bị mất tỉ lệ.

Nếu bạn ít tuổi thì gọi mình anh được rồi nhé . Bài này mình tra trên mạng kết hợp chỉnh sửa một tí chứ trước giờ cũng không nghiên cứu cái này
Không thì bạn nghiên cứu mở zip file excel đó, vào media mà lấy ảnh. Do mình không cần cái này nên không nghiên cứu nhưng mình biết là trong zip đó có file ảnh, và trên GPE này cũng có các bài về nén, giải nén rồi


Nhưng hình như giữa shape và picture nó không có tên phân biệt

 

[htin1997]

Nếu bạn ít tuổi thì gọi mình anh được rồi nhé . Bài này mình tra trên mạng kết hợp chỉnh sửa một tí chứ trước giờ cũng không nghiên cứu cái này
Không thì bạn nghiên cứu mở zip file excel đó, vào media mà lấy ảnh. Do mình không cần cái này nên không nghiên cứu nhưng mình biết là trong zip đó có file ảnh, và trên GPE này cũng có các bài về nén, giải nén rồi
View attachment 277248View attachment 277249

Nhưng hình như giữa shape và picture nó không có tên phân biệt

Vâng, cám ơn anh.
"Nhưng hình như giữa shape và picture nó không có tên phân biệt"- Như bài #1, ở đây em sử dụng chức năng Typename(Đối tượng), kết quả trả về là "Picture" hoặc "Rectangle",...

 

[Nhattanktnn]

Vâng, cám ơn anh.
"Nhưng hình như giữa shape và picture nó không có tên phân biệt"- Như bài #1, ở đây em sử dụng chức năng Typename(Đối tượng), kết quả trả về là "Picture" hoặc "Rectangle",...

Câu này là mình đang nói cho trường hợp mở file nén của nó cơ

 

[befaint]

Không thì bạn nghiên cứu mở zip file excel đó, vào media mà lấy ảnh.

Đúng rồi. Cách này là nhanh nhất, dùng 7z mở file Excel, kéo thả cái thư mục chứa các loại objects cần lấy ra là xong. Chả cần code kiếc gì cả.

 

[Nhattanktnn]

Đúng rồi. Cách này là nhanh nhất, dùng 7z mở file Excel, kéo thả cái thư mục chứa các loại objects cần lấy ra là xong. Chả cần code kiếc gì cả.

"Cái em cần là động đậy" cơ

 

[nhPhi]

Chào bác. em cũng đang làm cái này tuy nhiên gặp vấn đề là khi lưu ảnh từ shape (shape là QR code) thì ảnh nhận được là ảnh trắng chứ không có QR code trong đó. chỉ giáo giúp em với ạd