Xoá hình hàng loạt trong file excell bằng vba

Liên hệ QC

tuan16

Thành viên thường trực
Tham gia
28/11/13
Bài viết
285
Được thích
18
Em có file excell trong đó có hình vẽ biểu thị hình dạng của cốt thép. Em xin nhờ các anh chi trong diễn đàn giúp em cách xoá các hình ảnh này ạ
 

File đính kèm

  • gpe.xlsm
    28.2 KB · Đọc: 10
Em có file excell trong đó có hình vẽ biểu thị hình dạng của cốt thép. Em xin nhờ các anh chi trong diễn đàn giúp em cách xoá các hình ảnh này ạ
Xóa hết thì chọn 1 hình, ấn ctrl A rồi delete thôi, hoặc F5=> special => object rồi delete
Nếu nhất quyết VBA thì cũng làm như vậy nhưng record macro (lưu ý bỏ button "xóa hình" ra)
 
Upvote 0
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Delete
Next
 

File đính kèm

  • gpe.xlsm
    26.7 KB · Đọc: 11
Upvote 0
Bạn thử:
PHP:
Sub xoa()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.Name <> "Button 1398" Then
            sh.Delete
        End If
    Next
End Sub
 
Upvote 0
dạ em cảm ơn ạ. em quên là không xoá nút button. bác giúp em với ạ
Bạn thêm điều kiện của Button, ví dụ:
Mã:
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If Not sh.Name Like "Button*" Then
        sh.Delete
    End If
Next
 
Upvote 0
Bạn thử:
PHP:
Sub xoa()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.Name <> "Button 1398" Then
            sh.Delete
        End If
    Next
End Sub
em cảm ơn ạ
dạ em cảm ơn ạ. em quên là không xoá nút button. bác giúp em với ạ
Em cảm ơn ạ
Bài đã được tự động gộp:

Bạn thêm điều kiện của Button, ví dụ:
Mã:
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If Not sh.Name Like "Button*" Then
        sh.Delete
    End If
Next
dạ em cảm ơn
 
Upvote 0
Hoặc thế này:
PHP:
Sub DeleteShapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If sh.Type <> msoFormControl Then
            sh.Delete
    End If
Next
End Sub
 
Upvote 0
Hoặc thế này:
PHP:
Sub DeleteShapes()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    If sh.Type <> msoFormControl Then
            sh.Delete
    End If
Next
End Sub
Sub xoa()

Range("a7:i500,l7:m500").Select
Selection.ClearContents
End Sub

Sub xoa1()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Name <> "Button 1401" Then
sh.Delete
End If
Next
End Sub
Sub xoa2()
Sheets("TK THEP").Select
Anser = MsgBox("Ban co chac xoa toan bo khong ?", vbDefaultButton1 + vbYesNo, " are you sure ?")
If Anser = vbYes Then
Call xoa
Call xoa1
End If
End Sub
Dạ bác giúp em với ạ. em muốn tìm dòng cuối cùng ở cột a có chữa dữ liệu và muốn xóa dữ liệu đó thì phải sửa đoạn code trên sao ạ
 
Upvote 0
Dòng cuối lên google kiếm đâu thiếu đâu bạn?
dạ em không biết cho vào như nào ạ. mình tìm được dòng cuối xong rồi cho đoạn code vào như nào để nó hiểu là muốn xóa các dòng có chứa dữ liệu ạ.. ví dụ như em muốn xóa hết dữ liệu từ dòng a7 đến dòng cuối cùng của cột a có chứa dữ liệu ạ. Để thay thế cho đoạn Range("a7:i500,l7:m500").Select
 
Lần chỉnh sửa cuối:
Upvote 0
dạ em không biết cho vào như nào ạ. mình tìm được dòng cuối xong rồi cho đoạn code vào như nào để nó hiểu là muốn xóa các dòng có chứa dữ liệu ạ.. ví dụ như em muốn xóa hết dữ liệu từ dòng a7 đến dòng cuối cùng của cột a có chứa dữ liệu ạ
Mã:
Dim Lr as long
with sheets("tên sheet đưa vào đây")
    Lr=.range("A" & .rows.count).end(xlup).row
    .range("A7:A" & lr).clearcontents
End with
Mình gõ không biết có sai ký tự nào không, bạn thử có vấn đề gì phản hồi
(Có trường hợp chưa có dữ liệu nữa thì Lr sẽ nhỏ hơn 7 (tức 6), nên phải thêm điều kiện nữa nha. Mình lười quá bạn tìm hiểu thêm)
 
Upvote 0
Mã:
Dim Lr as long
with sheets("tên sheet đưa vào đây")
    Lr=.range("A" & .rows.count).end(xlup).row
    .range("A7:A" & lr).clearcontents
End with
Mình gõ không biết có sai ký tự nào không, bạn thử có vấn đề gì phản hồi
(Có trường hợp chưa có dữ liệu nữa thì Lr sẽ nhỏ hơn 7 (tức 6), nên phải thêm điều kiện nữa nha. Mình lười quá bạn tìm hiểu thêm)
Bác xem giúp em với ạ. em chưa biết cách cho đoạn code vào như nào với bác giúp em trường hợp chưa có dữ liệu nữa thì Lr sẽ nhỏ hơn 7 (tức 6), nữa với ạ
 

File đính kèm

  • GPE.xlsm
    35.9 KB · Đọc: 2
Upvote 0
Bác xem giúp em với ạ. em chưa biết cách cho đoạn code vào như nào với bác giúp em trường hợp chưa có dữ liệu nữa thì Lr sẽ nhỏ hơn 7 (tức 6), nữa với ạ
Bạn muốn xóa cột nào? cột A là không có dữ liệu gì rồi đó. Trường hợp cột A không có gì mà các cột khác có giá trị như trong file thì bạn muốn xóa thế nào?
1601339621183.png
 
Upvote 0
Bạn muốn xóa cột nào? cột A là không có dữ liệu gì rồi đó. Trường hợp cột A không có gì mà các cột khác có giá trị như trong file thì bạn muốn xóa thế nào?
View attachment 246322
dạ em quên chưa để dữ liệu ở cột a. em muốn tìm dữ liệu ở dòng cuối cột của côt b.. từ đó muốn xóa hết dữ liệu và hình ảnh từ dòng thứ 7 của các ô a,b,c,d,e,f,g ,h j , l,m đến dòng cuối cùng chứa dữ liệu tìm được ở cột b cũng tương ứng với các ô trên. như này ạ
 

File đính kèm

  • GPE.xlsm
    43.6 KB · Đọc: 2
Upvote 0
dạ em quên chưa để dữ liệu ở cột a. em muốn tìm dữ liệu ở dòng cuối cột của côt b.. từ đó muốn xóa hết dữ liệu và hình ảnh từ dòng thứ 7 của các ô a,b,c,d,e,f,g ,h j , l,m đến dòng cuối cùng chứa dữ liệu tìm được ở cột b cũng tương ứng với các ô trên. như này ạ
Tức là từ dòng 7 trở xuống (tất cả các cột) có nhiêu xóa hết?
 
Upvote 0
Tức là từ dòng 7 trở xuống (tất cả các cột) có nhiêu xóa hết?
dạ từ dòng 7 trở xuống của các cột a,b,c,d,e,f,g ,h j , l,m ... em không biết sao file em gửi lên không có hình ảnh. chỉ có dữ liệu. bác xem giúp xóa cả dữ liệu và hình ảnh với ạ
 
Upvote 0
dạ từ dòng 7 trở xuống của các cột a,b,c,d,e,f,g ,h j , l,m ... em không biết sao file em gửi lên không có hình ảnh. chỉ có dữ liệu. bác xem giúp xóa cả dữ liệu và hình ảnh với ạ
Code:
PHP:
Sub Test()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.Name <> "Button 3" Then
            sh.Delete
        End If
    Next
    With Sheet6
        .Range("L7:L" & Range("B" & Rows.Count).End(3).Row).ClearContents
        .Range("B7:I" & Range("B" & Rows.Count).End(3).Row).ClearContents
    End With
End Sub
 
Upvote 0
dạ từ dòng 7 trở xuống của các cột a,b,c,d,e,f,g ,h j , l,m ... em không biết sao file em gửi lên không có hình ảnh. chỉ có dữ liệu. bác xem giúp xóa cả dữ liệu và hình ảnh với ạ
Mình làm 3 sub riêng lẻ cho bạn tìm hiểu luôn:
PHP:
Option Explicit
Sub Del_Data()
Dim Lr As Long
Const StartRow As Long = 7
With Sheets("TK THEP")
    Lr = .Cells.Find("*", searchorder:=xlByRows, _
    searchdirection:=xlPrevious).Row
    If Lr < StartRow Then Exit Sub
    .Rows(StartRow & ":" & Lr).ClearContents
End With
End Sub

'*************************************************************
Sub Del_Shapes()
Dim sh As Shape
For Each sh In Sheets("TK THEP").Shapes
    If sh.Type <> msoFormControl Then
        sh.Delete
    End If
Next
End Sub

'*************************************************************
Sub Del_All()
Dim Anser As String
    Anser = MsgBox("Ban co chac xoa toan bo khong ?", _
            vbDefaultButton1 + vbYesNo, " Tuan tuti ?")
    If Anser = vbYes Then Call Del_Data: Call Del_Shapes
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom