Tính năng Save as pictures trong VBA

[htin1997]

Xin chào,

Như tiêu đề, mình không biết chức năng Save as pictures(khi chuột phải lên pictures) trong VBA viết thế nào. Đã Record macro nhưng không nhận code.
Google thì kết quả thường là biến đổi qua chart rồi Export.
Bác nào biết dòng code của tính năng này trong VBA chia sẽ cho mình với.

Cảm ơn

 

[BuiQuangThuan]

Như tiêu đề, mình không biết chức năng Save as pictures(khi chuột phải lên pictures) trong VBA viết thế nào. Đã Record macro nhưng không nhận code.

https://www.thespreadsheetguru.com/blog/vba-save-as-picture-file-excel
Thử đọc bài này coi nè bạn

 

[htin1997]

https://www.thespreadsheetguru.com/blog/vba-save-as-picture-file-excel
Thử đọc bài này coi nè bạn

Xin phép gửi code vào đây cho ai cần:
Em tuỳ biến lại 1 ít với chỉ lấy tất cả ảnh, không lấy shape, kích thước xuất ra sẽ gấp đôi, thêm randbetween để không bị ghi đè ảnh.
Nguồn Internet:

Sub saveaspicture()
On Error Resume Next
ActiveSheet.Pictures.Select
For Each oShape In Selection 'ActiveSheet.Shapes
x = x + 1
    strImageName = ActiveSheet.Cells(oShape.TopLeftCell.Row, 1).Value
    oShape.Select
    'Picture format initialization
    'Selection.ShapeRange.PictureFormat.Contrast = 0.5: Selection.ShapeRange.PictureFormat.Brightness = 0.5: Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic: Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse: Selection.ShapeRange.Fill.Visible = msoFalse: Selection.ShapeRange.Line.Visible = msoFalse: Selection.ShapeRange.Rotation = 0#: Selection.ShapeRange.PictureFormat.CropLeft = 0#: Selection.ShapeRange.PictureFormat.CropRight = 0#: Selection.ShapeRange.PictureFormat.CropTop = 0#: Selection.ShapeRange.PictureFormat.CropBottom = 0#: Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft: Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
    '/Picture format initialization
    Application.Selection.CopyPicture
    Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width * 2, oShape.Height * 2)
    Set oChartArea = oDia.Chart
    oDia.Activate
    With oChartArea
        .ChartArea.Select
        .Paste
        .Export ("D:\PIcs\" & x & "____" & Application.WorksheetFunction.RandBetween(1, 9999) & ".jpg")
    End With
    oDia.Delete 'oChartArea.Delete
Next
End Sub