Zdravím zjistil jsem ze nedokazu ve vybrane oblasti oznacit ruzne objekty (obrazky vlozene tvary atd..) CTRL+G jinak Objekty oznaci uplne vsechny ale ja potrebuju jen v oblasti co oznacim je na to nejaky zpusob? diky za radu..
Ale ActiveX nepôjdu:
Sub ObjektyVoVybere()
Dim SH As Shape, R As Long, B As Long, L As Long, T As Long, Co As Integer, Ro As Long, SHL As Long, SHT As Long, SEL As String
If TypeName(Selection) <> "Range" Then Exit Sub
With Selection
Co = .Columns.Count: Ro = .Rows.Count
L = .Left: T = .Top: B = .Offset(Ro, 0).Top - 1: R = .Offset(0, Co).Left - 1
End With
With ThisWorkbook.ActiveSheet
For Each SH In .Shapes
With SH
SHL = .Left: SHT = .Top
If SHL >= L And SHL + .Width - 1 <= R And SHT >= T And SHT + .Height - 1 <= B Then SEL = SEL & IIf(SEL = "", "", vbCr) & .Name
End With
Next SH
End With
If SEL <> "" Then ActiveSheet.Shapes.Range(Split(SEL, vbCr)).Select
Set SH = Nothing
End Subcitovat
Sub ObjektyVoVybere()
Dim SH As Shape, R As Long, B As Long, L As Long, T As Long, Co As Integer, Ro As Long, SHL As Long, SHT As Long, SEL As String
If TypeName(Selection) <> "Range" Then Exit Sub
With Selection
Co = .Columns.Count: Ro = .Rows.Count
L = .Left: T = .Top: B = .Offset(Ro, 0).Top - 1: R = .Offset(0, Co).Left - 1
End With
With ThisWorkbook.ActiveSheet
For Each SH In .Shapes
With SH
SHL = .Left: SHT = .Top
If SHL >= L And SHL + .Width - 1 <= R And SHT >= T And SHT + .Height - 1 <= B Then SEL = SEL & IIf(SEL = "", "", vbCr) & .Name
End With
Next SH
End With
If SEL <> "" Then ActiveSheet.Shapes.Range(Split(SEL, vbCr)).Select
Set SH = Nothing
End Subcitovat
\n
RSS nejnovější články