Sửa code ảnh vừa khịt trong ô và kéo ô ảnh di chuyển theo (3 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

songiang5011

Thành viên chính thức
Tham gia
6/7/21
Bài viết
50
Được thích
10
Em chào anh chị trong diễn đàn, nhờ anh chị sửa code giúp em, em muốn ảnh vừa khịt vào ô (kể cả khi gộp ô) và khi kéo dãn ô, ảnh di chuyển giãn theo.
Vậy mong anh chị sửa code giúp em, em cám ơn ạ
1748880100459.png
 

File đính kèm

Chỉ thấy có từ vừa khít, chưa bao giờ gặp trường hợp vừa "khịt".
Có lẽ trong excel không hỗ trợ nhiều về chỉnh sửa ảnh như mong muốn của bạn, nếu có thì chắc code cũng khá phức tạp.
Dạ, ý em là vừa ô đó, mong anh hỗ trợ giúp em.
 
Upvote 0
Em muốn sửa lại code, để cho ảnh vừa vào 1 ô (Nếu gộp ô vừa cả ô gộp) và khi giãn ô ảnh cũng giãn theo ạ.

Function ChenAnh(maSP As Range) As String
Dim ws As Worksheet
Dim cell As Range, vung As Range
Dim newShp As Shape
Dim tenAnhGoc As String, tenAnhMoi As String
Dim i As Integer
Dim folderPath As String
Dim filePath As String
Dim wsData As Worksheet
Dim wsCaller As Worksheet

On Error GoTo KetThuc

Set cell = Application.Caller
Set wsCaller = cell.Worksheet

If wsCaller.Name <> Application.ActiveSheet.Name Then Exit Function

If cell.MergeCells Then
Set vung = cell.MergeArea
Else
Set vung = cell
End If

Set wsData = ThisWorkbook.Sheets("Anh")
folderPath = wsData.Range("F2").Value
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

tenAnhMoi = "Anh_" & cell.Address(0, 0)

Application.ScreenUpdating = False

For i = wsCaller.Shapes.Count To 1 Step -1
If wsCaller.Shapes(i).Name = tenAnhMoi Then
wsCaller.Shapes(i).Delete
Exit For
End If
Next i

If Trim(maSP.Value) = "" Then GoTo KetThuc

tenAnhGoc = Trim(maSP.Value) & ".jpg"
filePath = folderPath & tenAnhGoc
If Dir(filePath) = "" Then
tenAnhGoc = Trim(maSP.Value) & ".png"
filePath = folderPath & tenAnhGoc
If Dir(filePath) = "" Then GoTo KetThuc
End If

Set newShp = wsCaller.Shapes.AddPicture(filePath, _
msoFalse, msoCTrue, vung.Left, vung.Top, -1, -1)
newShp.Name = tenAnhMoi

With newShp
.LockAspectRatio = msoTrue
If (.Width / .Height) > (vung.Width / vung.Height) Then
.Width = vung.Width - 2
.Height = .Width * (.Height / .Width)
Else
.Height = vung.Height - 2
.Width = .Height * (.Width / .Height)
End If
.Top = vung.Top + (vung.Height - .Height) / 2
.Left = vung.Left + (vung.Width - .Width) / 2
.Placement = xlMoveAndSize
End With

KetThuc:
Application.ScreenUpdating = True
End Function
Bài đã được tự động gộp:

em muốn dùng công thức=chenanh(ô tên ảnh) thì ảnh sẽ hiện vừa vào ô đó luôn (kế cả ô gộp) và khi giãn dòng anh di chuyển theo ạ
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom