모양이 배치되어 있는지 확인하고 싶은 범위가 있습니다.
온라인에서 스크립트를 찾았 지만 ( http://www.mrexcel.com/forum/excel-questions/317711-visual-basic-applications-identify-top-left-cell-selected-range.html ) Excel 2003에서 작동합니다. 지금까지 발견 된 스크립트에서 수정 된 코드 :
Public Function removeOLEtypesOfType() As Boolean
On Error Resume Next
Dim objTopLeft As Range, objBotRight As Range _
, objRange As Range, objShape As Shape
Set objRange = Sheet1.Range(COLUMN_HEADINGS)
objRange.Select
With Selection
Dim intFirstCol As Integer, intFirstRow As Integer _
, intLastCol As Integer, intLastRow As Integer
intFirstCol = .Column
intFirstRow = .Row
Set objTopLeft = .Cells(intFirstRow, intFirstCol) '.Address(0, 0)
intLastCol = .Columns.Count + .Column - 1
intLastRow = .Rows.Count + .Row - 1
Set objBotRight = .Cells(intLastRow, intLastCol) '.Address(0, 0)
If objTopLeft Is Nothing Or objBotRight Is Nothing Then
MsgBox "Cannot get topleft or bottom right of range!", vbExclamation
removeOLEtypesOfType = False
Exit Function
End If
For Each objShape In ActiveSheet.Shapes
Dim objTLis As Range
Set objTLis = Intersect(objTopLeft, objShape.TopLeftCell)
If Not objTLis Is Nothing Then
Dim objBRis As Range
Set objBRis = Intersect(objBotRight, objShape.BottomRightCell)
If Not objBRis Is Nothing Then
objShape.Delete
End If
End If
Next
End With
Sheet1.Cells(1, 1).Select
removeOLEtypesOfType = True
End Function
objTopLeft 및 objBotRight는 모두 Nothing이고 COLUMN_HEADINGS에는 범위 이름이 포함됩니다.
디버거에서 intFirstCol, intFirstRow, intLastCol 및 intLastRow를 확인했으며 정확합니다.
편집 ... .Address가 주석 처리 된 경우 왼쪽 상단과 오른쪽 아래 범위가 모두 반환되지만 .Address가 입력되면 둘 다 Nothing입니다. 반환 된 범위가 올바른 위치에 대한 것이 아닙니다.
예를 들어 제공된 범위의 경우 :
intFirstCol = 3
intFirstRow = 11
intLastCol = 3
intLastRow = 186
그러나 위의 내용은 정확합니다.
objTopLeft.Column = 5
objTopLeft.Row = 21
objBotRight.Column = 5
objBotRight.Row = 196
위의 내용이 올바르지 않고 열이 +2이고 행이 +10입니다. 왜 그런가요?
결정된:
Public Function removeOLEtypesOfType() As Boolean
On Error Resume Next
Dim objTopLeft As Range, objBotRight As Range _
, objRange As Range, objShape As Shape
Set objRange = Sheet1.Range(COLUMN_HEADINGS)
objRange.Select
With Selection
Set objTopLeft = .Cells(1)
Set objBotRight = .Cells(.Cells.Count)
If objTopLeft Is Nothing Or objBotRight Is Nothing Then
MsgBox "Cannot get topleft or bottom right of range!", vbExclamation
removeOLEtypesOfType = False
Exit Function
End If
For Each objShape In ActiveSheet.Shapes
Dim blnTLcol As Boolean, blnTLrow As Boolean _
, blnBRcol As Boolean, blnBRrow As Boolean
blnTLcol = (objShape.TopLeftCell.Column >= objTopLeft.Column)
blnTLrow = (objShape.TopLeftCell.Row >= objTopLeft.Row)
blnBRcol = (objShape.BottomRightCell.Column <= objBotRight.Column)
blnBRrow = (objShape.BottomRightCell.Row <= objBotRight.Row)
If blnTLcol = True And blnTLrow = True _
And blnBRcol = True And blnBRrow = True Then
objShape.Delete
End If
Next
End With
Sheet1.Cells(1, 1).Select
removeOLEtypesOfType = True
End Function
감사합니다 @Ambie 루틴을 단순화했으며 이것이 문제가 아니지만 코드를 정리하는 데 도움이 되었기 때문에 답을 줄 수 없습니다.
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다