forked from Vitosh/VBA_personal
-
Notifications
You must be signed in to change notification settings - Fork 5
/
Shapes.vb
116 lines (81 loc) · 3.16 KB
/
Shapes.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Option Explicit
Sub ShapeNames()
Dim sh_shape As shape
For Each sh_shape In ActiveSheet.Shapes
Debug.Print sh_shape.Name
Next sh_shape
End Sub
Public Sub GetSomething(str_something As String)
ActiveSheet.Shapes(str_something).Select
End Sub
'Makes shape visible and invisble.
Sub translatorField_Klicken()
Dim blnEnglish As Boolean
Dim rngRange As Range
Dim myShape As shape
Set myShape = tblInput.Shapes("translatorField")
Set rngRange = tblSettings.Cells(2, 2)
blnEnglish = Not CBool(rngRange)
tblSettings.Cells(2, 2) = blnEnglish
If blnEnglish Then
tblInput.[h1].value = tblSettings.[i1].value
With myShape.Fill
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 1
End With
With myShape.TextFrame2.TextRange.Characters(1, 66).Font.Fill
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 1
End With
Else
tblInput.[h1].value = tblSettings.[c1].value
With myShape.Fill
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
End With
With myShape.TextFrame2.TextRange.Characters(1, 66).Font.Fill
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
End If
End Sub
'---------------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Sub TestMe()
Dim shp As Shape
Dim arrOfShapes() As Variant
With ActiveSheet
For Each shp In .Shapes
If InStrB(shp.Name, "Rec") > 0 Then
arrOfShapes = incrementArray(arrOfShapes, shp.Name)
End If
Next
If IsArrayAllocated(arrOfShapes) Then
Debug.Print .Shapes.Range(arrOfShapes(0)).Name
.Shapes.Range(arrOfShapes).Delete
End If
End With
End Sub
Public Function incrementArray(arrOfShapes As Variant, nameOfShape As String) As Variant
Dim cnt As Long
Dim arrNew As Variant
If IsArrayAllocated(arrOfShapes) Then
ReDim arrNew(UBound(arrOfShapes) + 1)
For cnt = LBound(arrOfShapes) To UBound(arrOfShapes)
arrNew(cnt) = CStr(arrOfShapes(cnt))
Next cnt
arrNew(UBound(arrOfShapes) + 1) = CStr(nameOfShape)
Else
arrNew = Array(nameOfShape)
End If
incrementArray = arrNew
End Function
Function IsArrayAllocated(Arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(Arr) And _
Not IsError(LBound(Arr, 1)) And _
LBound(Arr, 1) <= UBound(Arr, 1)
End Function
Credits to this guy for the finding that the arrOfShapes should be declared with parenthesis (I have spent about 30 minutes researching why I could not pass it correctly) and to CPearson for the IsArrayAllocated().