Hỏi code để cho "Picture" luôn ở dòng cuối cùng (1 người xem)

Liên hệ QC

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

Tường_Vi

Thành viên tiêu biểu
Tham gia
19/4/10
Bài viết
482
Được thích
121
Nghề nghiệp
Luôn tìm kiếm một vị trí tốt hơn
Ở phía cuối bảng tính em có dòng code sau
PHP:
With Sheet2.[C65000].End(xlUp)
                       .Offset(1, 0) = "TOTAL"
                       .Offset(1, 1) = WorksheetFunction.Sum(Range("D7:D" & [D65000].End(xlUp).Row))
                       .Offset(2, 2) = "Checked by"
                       .Offset(11, 2) = "Nguyen thi NA MIT"
 End With

Giờ từ dòng NA MIT này trượt xuống 2 cell, em chèn một Picture5
em sử dụng code sau nhưng không được. Em không biết sai ở đâu?


PHP:
With Sheet2.Shapes("Picture5")
  '.LockAspectRatio = False
  .Left = Sheet2.[C65000].End(xlUp).Offset(4, 2).Left
  .Top = Sheet2.[C65000].End(xlUp).Offset(4, 2).Top

End With
 
Gửi file lên đi bạn! Tôi sẽ thử xem sao!
 
Upvote 0
Tôi làm cho bạn luôn, nếu chưa đúng ý thì ta lại bàn tiếp!

Tôi phải có hàm kiểm tra file có tồn tại hay không:

Mã:
Function FileExist(ByVal filePath As String) As Boolean
    FileExist = CreateObject("Scripting.FileSystemObject").FileExists(filePath)
End Function

Sau đó tôi mới làm thủ tục gán hình:

Trước tiên bạn phải có một hình sẳn ở một thư mục nào đó, trong trường hợp này, tôi đặt chung thư mục với file excel đang thực hiện.

Và thủ tục như sau:

Mã:
Sub PictInsert()
    On Error Resume Next [B][COLOR=#008000]'(bat buoc phai de dong nay vi doi khi khong ton tai Shapes("Picture5") trong sheet2[/COLOR][/B]
    [B][COLOR=#ff0000]Sheet2.Shapes("Picture5").Delete[/COLOR][/B]
    Dim PicName As String, PicRange As Range
    Set PicRange = Sheet2.[C65536].End(xlUp).Offset(4, 2)
    PicName = ThisWorkbook.Path & "\Picture5.JPG"
    If FileExist(PicName) Then
        With Sheet2.Pictures.Insert(PicName)
            .ShapeRange.LockAspectRatio = msoFalse
           [COLOR=#ff0000][B] .Name = "Picture5" [/B][/COLOR][COLOR=#008000][B]'<< Nho phai dat ten cho no truoc nhe[/B][/COLOR]
            .Top = PicRange.Top
            .Left = PicRange.Left
            .Width = PicRange.Width
            .Height = PicRange.Height
        End With
    Else
        MsgBox "Tôi không tìm duoc hình!"
    End If
End Sub

Lưu ý: Khi ở ngoài thì Hình có thể là tên A, nhưng lúc ta Insert thì hình trở thành 1 tên khác mà Excel mặc định sẽ thêm vào, chẳng hạn: Picture* nào đó, cho nên ta phải đặt lại tên cho nó.

Bây giờ, bạn có thể tải file, giải nén và thực hiện trên nút lệnh!
 

File đính kèm

Upvote 0
Dear Anh Nghĩa
Em làm được rồi
Cám ơn Anh
 
Upvote 0

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

Back
Top Bottom