Bạn thử code này:
Sub FitPic()
If TypeName(Selection) = "Picture" Then
With Selection
.ShapeRange.LockAspectRatio = False
.Height = .TopLeftCell.Height - 0.2
.Width = .TopLeftCell.Width - 0.2
.Top = .TopLeftCell.Top + 0.1
.Left = .TopLeftCell.Left + 0.1
End With
Else
MsgBox "Select a picture before running this macro."
End If
End Sub
www.giaiphapexcel.com
dạ code được rồi ạ, cháu cảm ơn bác ạ
dạ vâng, lâu lắm mới thấy anh đăng bàiBạn có thể tham khảo hàm chỉnh ảnh bên bài viết bên này:
Các Hàm quản lý ảnh: vị trí, kích thước, cắt, xóa, sắp xếp
Hôm nay tôi chia sẻ với bạn các Hàm bổ trợ quản lý ảnh cực kỳ thú vị, chức năng bao gồm: chỉnh vị trí, kích thước, cắt, xóa và sắp xếp ảnh một cách đơn giản, thuận tiện và nhanh gọn, giúp các bạn bớt khó khăn trong việc tinh chỉnh ảnh khi trong trang tính của bạn có quá nhiều đối tượng hình ảnh...
Bạn thêm vòng lặp vào sẽ chạy hết các ảnh.
Có phải ai cũng biết để trả lời được bạn đâu, giả sử có bạn nào đó biết thì cũng chưa chắc có thời gian rảnh mà.
Từ code của anh huuthang_bd, mình thêm phần chọn tất cả ảnh và làm vừa ô excel. Các phần khác bạn tự nghiên cứu nhé.
Cho đồng chí này, nọ mới đào mộ xong. Người vẫn còn thấy lành lạnh nên nay chỉ đường thôi nhé.
Em cảm ơn bác! em đã làm được.
Sub CropAndCenter(ByVal shp As Shape, ByVal cLeft As Double, ByVal cTop As Double, ByVal cRight As Double, ByVal cBottom As Double)
Dim w As Double, h As Double, khung As Range
With shp
Set khung = shp.Parent.Range(.Name)
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
With .PictureFormat
.CropLeft = cLeft
.CropRight = cRight
.CropTop = cTop
.CropBottom = cBottom
End With
w = khung.Width
h = w * .Height / .Width
If h > khung.Height Then
h = khung.Height
w = h * .Width / .Height
End If
.Left = khung.Left + (khung.Width - w) / 2
.Top = khung.Top + (khung.Height - h) / 2
.Width = w
.Height = h
End With
End Sub With ThisWorkbook.Worksheets("Sheet1")
On Error Resume Next
CropAndCenter .Shapes(cell_.Address), .Range("A1").Value, .Range("B1").Value, .Range("C1").Value, .Range("D1").Value
On Error GoTo 0
End Withem cảm ơn bác. Cái em đang cần là chỉnh ảnh chứ không phải chèn ảnh.
Bạn thông cảm, mình không giúp những trường hợp viết tiếng Tây và viết tắt. Bạn nhờ người khác nhé.Thank you very much!
