清空数据和图片，求指点下思路

760636412

求大神指点下，谢谢



详细附件： 清空数据.zip (1.43 MB, 下载次数: 10)

2024-5-30 11:53 上传

点击文件名下载附件

cidanji

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2. Dim r&, shp As Shape
   
3. If T.Address Like "*:*" Then Exit Sub
   
4. r = T.Row
   
5. If T.Column = 6 And r > 7 And T = "" Then
   
6.     For Each shp In Me.Shapes
   
7.         If shp.TopLeftCell.Address = Cells(r, 13).Address Then shp.Delete: Exit For
   
8.     Next
   
9.     Cells(r, 1).Resize(1, 13).ClearContents
   
10. End If
    
11. End Sub

复制代码

liulang0808

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Columns(6), Target) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each Rng In Application.Intersect(Columns(6), Target)
        If Rng.Row >= 8 Then
            If Len(Rng) = 0 Then
                Rng.EntireRow.ClearContents
                For Each shp In ActiveSheet.Shapes
                    If shp.TopLeftCell.Address = Cells(Rng.Row, 13).Address Then
                        shp.Delete
                    End If
                Next shp
            End If
        End If
    Next Rng
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

liulang0808

供 参考。。。。。。

gwjkkkkk

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row < 7 Then Exit Sub
    If Target.Column = 6 Then
        If Target.Value = "" Then
            Application.EnableEvents = False
                Rows(Target.Row).ClearContents
                Call hasPic(Target.Offset(, 7))
            Application.EnableEvents = True
        End If
    End If
End Sub

Function hasPic(Rng As Range)
    Dim shp As Shape
    For Each shp In Rng.Parent.Shapes
        If shp.Type = 13 Then
            If Abs((shp.Left + shp.Width / 2) - (Rng.Left + Rng.Width / 2)) < (shp.Width + Rng.Width) / 2 And _
               Abs((shp.Top + shp.Height / 2) - (Rng.Top + Rng.Height / 2)) < (shp.Height + Rng.Height) / 2 Then
               shp.Delete
            End If
        End If
    Next
End Function

gwjkkkkk

................