xin code VBA tự động chỉnh ảnh bằng với ô

One Response

1. hands says:

   15/01/2023 at 2:36 pm

   Như bài em nhờ trước đó code tương tự mà không có ai trả lời [URL='www.giaiphapexcel.com/diendan/threads/xin-giúp-đỡ-sửa-code-vba-chỉnh-ảnh-vừa-ô.163733/']Link

   Bạn thêm vòng lặp vào sẽ chạy hết các ảnh.

   Bác ơi có thể multiselect được không ạ?

   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à.

   Dạ vâng! Cảm ơn bác.
   Ý em không phải là mọi người phải trả lời ạ. Em thêm smile buồn vào mà nó không hiện (em đang dùng trình duyệt trên điện thoại)

   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.
   1847
   Các phần khác bạn tự nghiên cứu nhé.

   Em cảm ơn bác! em đã làm được.
   Nếu có thể bác giúp em thêm với ạ.
   1. đối với ô merge thì không sử dụng được ạ
   2. em muốn vừa chỉnh ''vừa ô'' vừa "crop" theo như code dưới đây có áp dụng được không ạ?

   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

   – Cái dưới này em không biết chèn vô đâu

   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 With

   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é.
   Cách làm khác cách phát lộc phát, có điều đáp ứng được merge và fit trong khi chờ người nơi ấy.
   Link: [URL='www.giaiphapexcel.com/diendan/threads/ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o.51408/']Hey
   Trước mình test ổn cả rồi, vào đấy làm theo, cấm hỏi nữa nhé. Vì mình cũng chỉ biết đọc, làm theo, và được.

   em cảm ơn bác. Cái em đang cần là chỉnh ảnh chứ không phải chèn ảnh.
   Chèn ảnh hàng loạt vừa ô + crop ảnh em có code lấy của anh Batman1 rồi ạ. bác có cần em chia sẻ tham khảo ạ.

   Reply