Skip to content

Commit 399e2b7

Browse files
vbatoolsvbatools
committed
add hot keys module
add hot keys module
1 parent e21ca91 commit 399e2b7

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

67 files changed

+9131
-8700
lines changed

‎Addin_MacroTools_ENG.xlsb‎

3.39 KB
Binary file not shown.

‎Addin_MacroTools_RUS.xlsb‎

236 KB
Binary file not shown.

‎scripts/Class_Modules/CAnchors.cls‎

Lines changed: 167 additions & 167 deletions
Original file line numberDiff line numberDiff line change
@@ -32,183 +32,183 @@ Private m_blnResizing As Boolean
3232
Public WithEvents ResizeHandle As MSForms.Label
3333
Attribute ResizeHandle.VB_VarHelpID = -1
3434
Public Property Set AddCntrl(ByRef RHS As MSForms.control)
35-
25: Dim clsTemp As CAnchor
36-
26: Set clsTemp = New CAnchor
37-
27: Set clsTemp.cnt = RHS
38-
28: With clsTemp
39-
29: .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
40-
30: .MinimumWidth = .cnt.Width
41-
31: .MinimumHeight = .cnt.Height
42-
32: .OrigLeft = .cnt.Left
43-
33: .OrigTop = .cnt.top
44-
34: .OrigWidth = .cnt.Width
45-
35: .OrigHeight = .cnt.Height
46-
36: End With
47-
37: m_colAnchors.Add clsTemp, clsTemp.cnt.Name
48-
38: End Property
35+
23: Dim clsTemp As CAnchor
36+
24: Set clsTemp = New CAnchor
37+
25: Set clsTemp.cnt = RHS
38+
26: With clsTemp
39+
27: .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
40+
28: .MinimumWidth = .cnt.Width
41+
29: .MinimumHeight = .cnt.Height
42+
30: .OrigLeft = .cnt.Left
43+
31: .OrigTop = .cnt.top
44+
32: .OrigWidth = .cnt.Width
45+
33: .OrigHeight = .cnt.Height
46+
34: End With
47+
35: m_colAnchors.Add clsTemp, clsTemp.cnt.Name
48+
36: End Property
4949
Public Sub RemoveCntrl(ByRef varIndex As Variant)
50-
40: On Error Resume Next
51-
41: m_colAnchors.Remove varIndex
52-
42: End Sub
50+
38: On Error Resume Next
51+
39: m_colAnchors.Remove varIndex
52+
40: End Sub
5353
Private Sub m_AddResizer(ByRef objParent As Object)
54+
42: '
55+
43: ' add resizing control to bottom righthand corner of userform
5456
44: '
55-
45: ' add resizing control to bottom righthand corner of userform
56-
46: '
57-
47: Set ResizeHandle = objParent.Controls.Add("Forms.label.1", MRESIZEHANDLE, True)
58-
48: With ResizeHandle
59-
49: With .Font
60-
50: .Name = "Marlett"
61-
51: .Charset = 2
62-
52: .Size = 14
63-
53: .Bold = True
64-
54: End With
65-
55: .BackStyle = fmBackStyleTransparent
66-
56: .AutoSize = True
67-
57: .BorderStyle = fmBorderStyleNone
68-
58: .Caption = "o"
69-
59: .MousePointer = fmMousePointerSizeNWSE
70-
60: .ForeColor = &H8000000D
71-
61: .ZOrder
72-
62: .top = objParent.InsideHeight - .Height
73-
63: .Left = objParent.InsideWidth - .Width
74-
64: End With
75-
65: End Sub
57+
45: Set ResizeHandle = objParent.Controls.Add("Forms.label.1", MRESIZEHANDLE, True)
58+
46: With ResizeHandle
59+
47: With .Font
60+
48: .Name = "Marlett"
61+
49: .Charset = 2
62+
50: .Size = 14
63+
51: .Bold = True
64+
52: End With
65+
53: .BackStyle = fmBackStyleTransparent
66+
54: .AutoSize = True
67+
55: .BorderStyle = fmBorderStyleNone
68+
56: .Caption = "o"
69+
57: .MousePointer = fmMousePointerSizeNWSE
70+
58: .ForeColor = &H8000000D
71+
59: .ZOrder
72+
60: .top = objParent.InsideHeight - .Height
73+
61: .Left = objParent.InsideWidth - .Width
74+
62: End With
75+
63: End Sub
7676
Private Sub ResizeHandle_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
77-
67: If Button = 1 Then
78-
68: m_sngLeftResizePos = X
79-
69: m_sngTopResizePos = Y
80-
70: m_blnResizing = True
81-
71: End If
82-
72: End Sub
77+
65: If Button = 1 Then
78+
66: m_sngLeftResizePos = X
79+
67: m_sngTopResizePos = Y
80+
68: m_blnResizing = True
81+
69: End If
82+
70: End Sub
8383
Private Sub ResizeHandle_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
84-
74: Dim sngSize As Single
85-
75: If Button = 1 Then
86-
76: With ResizeHandle
87-
77: .MOVE .Left + X - m_sngLeftResizePos, .top + Y - m_sngTopResizePos
88-
78: sngSize = m_frmParent.Width + X - m_sngLeftResizePos
89-
79: If sngSize < Me.MinimumWidth Then sngSize = MinimumWidth
90-
80: m_frmParent.Width = sngSize
91-
81: sngSize = m_frmParent.Height + Y - m_sngTopResizePos
92-
82: If sngSize < MinimumHeight Then sngSize = MinimumHeight
93-
83: m_frmParent.Height = sngSize
94-
84: .Left = m_frmParent.InsideWidth - .Width
95-
85: .top = m_frmParent.InsideHeight - .Height
96-
86: If UpdateWhilstDragging Then
97-
87: m_UpdateControls
98-
88: End If
99-
89: End With
100-
90: End If
101-
91: End Sub
84+
72: Dim sngSize As Single
85+
73: If Button = 1 Then
86+
74: With ResizeHandle
87+
75: .MOVE .Left + X - m_sngLeftResizePos, .top + Y - m_sngTopResizePos
88+
76: sngSize = m_frmParent.Width + X - m_sngLeftResizePos
89+
77: If sngSize < Me.MinimumWidth Then sngSize = MinimumWidth
90+
78: m_frmParent.Width = sngSize
91+
79: sngSize = m_frmParent.Height + Y - m_sngTopResizePos
92+
80: If sngSize < MinimumHeight Then sngSize = MinimumHeight
93+
81: m_frmParent.Height = sngSize
94+
82: .Left = m_frmParent.InsideWidth - .Width
95+
83: .top = m_frmParent.InsideHeight - .Height
96+
84: If UpdateWhilstDragging Then
97+
85: m_UpdateControls
98+
86: End If
99+
87: End With
100+
88: End If
101+
89: End Sub
102102
Private Sub ResizeHandle_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
103-
93: If Button = 1 Then
104-
94: If Not UpdateWhilstDragging Then
105-
95: m_UpdateControls
106-
96: End If
107-
97: m_blnResizing = False
108-
98: End If
109-
99: End Sub
103+
91: If Button = 1 Then
104+
92: If Not UpdateWhilstDragging Then
105+
93: m_UpdateControls
106+
94: End If
107+
95: m_blnResizing = False
108+
96: End If
109+
97: End Sub
110110
Public Function funAnchor(ByRef varIndex As Variant) As CAnchor
111-
101: ' access to specific anchored control
112-
102: On Error Resume Next
113-
103: Set funAnchor = m_colAnchors(varIndex)
114-
104: End Function
111+
99: ' access to specific anchored control
112+
100: On Error Resume Next
113+
101: Set funAnchor = m_colAnchors(varIndex)
114+
102: End Function
115115
Public Function Anchors() As Collection
116-
106: ' access to the collection of anchored controls
117-
107: Set Anchors = m_colAnchors
118-
108: End Function
116+
104: ' access to the collection of anchored controls
117+
105: Set Anchors = m_colAnchors
118+
106: End Function
119119
Public Property Set objParent(ByRef RHS As Object)
120+
108: '
121+
109: ' Use this to assign all default properties
120122
110: '
121-
111: ' Use this to assign all default properties
122-
112: '
123-
113: Dim clsTemp As CAnchor
124-
114: Dim cntTemp As MSForms.control
125-
115: Set m_frmParent = RHS
126-
116: UpdateWhilstDragging = True '!!
127-
117: With RHS
128-
118: MinimumWidth = .Width
129-
119: MinimumHeight = .Height
130-
120: OrigLeft = 1
131-
121: OrigTop = 1
132-
122: OrigWidth = .InsideWidth
133-
123: OrigHeight = .InsideHeight
134-
124: End With
135-
125: For Each cntTemp In m_frmParent.Controls
136-
126: Set clsTemp = New CAnchor
137-
127: Set clsTemp.cnt = cntTemp
138-
128: With clsTemp
139-
129: .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
140-
130: .MinimumWidth = cntTemp.Width
141-
131: .MinimumHeight = cntTemp.Height
142-
132: .OrigLeft = cntTemp.Left
143-
133: .OrigTop = cntTemp.top
144-
134: .OrigWidth = cntTemp.Width
145-
135: .OrigHeight = cntTemp.Height
146-
136: End With
147-
137: m_colAnchors.Add clsTemp, clsTemp.cnt.Name
148-
138: Next
149-
139: m_AddResizer RHS
150-
140: End Property
123+
111: Dim clsTemp As CAnchor
124+
112: Dim cntTemp As MSForms.control
125+
113: Set m_frmParent = RHS
126+
114: UpdateWhilstDragging = True '!!
127+
115: With RHS
128+
116: MinimumWidth = .Width
129+
117: MinimumHeight = .Height
130+
118: OrigLeft = 1
131+
119: OrigTop = 1
132+
120: OrigWidth = .InsideWidth
133+
121: OrigHeight = .InsideHeight
134+
122: End With
135+
123: For Each cntTemp In m_frmParent.Controls
136+
124: Set clsTemp = New CAnchor
137+
125: Set clsTemp.cnt = cntTemp
138+
126: With clsTemp
139+
127: .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
140+
128: .MinimumWidth = cntTemp.Width
141+
129: .MinimumHeight = cntTemp.Height
142+
130: .OrigLeft = cntTemp.Left
143+
131: .OrigTop = cntTemp.top
144+
132: .OrigWidth = cntTemp.Width
145+
133: .OrigHeight = cntTemp.Height
146+
134: End With
147+
135: m_colAnchors.Add clsTemp, clsTemp.cnt.Name
148+
136: Next
149+
137: m_AddResizer RHS
150+
138: End Property
151151
Private Sub Class_Initialize()
152-
142: Set m_colAnchors = New Collection
153-
143: End Sub
152+
140: Set m_colAnchors = New Collection
153+
141: End Sub
154154
Private Sub Class_Terminate()
155-
145: Do While m_colAnchors.Count > 0
156-
146: m_colAnchors.Remove m_colAnchors.Count
157-
147: Loop
158-
148: Set m_colAnchors = Nothing
159-
149: m_frmParent.Controls.Remove MRESIZEHANDLE
160-
150: Set ResizeHandle = Nothing
161-
151: End Sub
162-
Private Sub m_UpdateControls()
155+
143: Do While m_colAnchors.Count > 0
156+
144: m_colAnchors.Remove m_colAnchors.Count
157+
145: Loop
158+
146: Set m_colAnchors = Nothing
159+
147: m_frmParent.Controls.Remove MRESIZEHANDLE
160+
148: Set ResizeHandle = Nothing
161+
149: End Sub
162+
Private Sub m_UpdateControls()
163+
151: '
164+
152: ' Calculate New position of all controls
163165
153: '
164-
154: ' Calculate New position of all controls
165-
155: '
166-
156: Dim clsAnchor As CAnchor
167-
157: Dim cntTemp As MSForms.control
168-
158: Dim sngLeft As Single
169-
159: Dim sngTop As Single
170-
160: Dim sngHeight As Single
171-
161: Dim sngWidth As Single
172-
162: For Each clsAnchor In m_colAnchors
173-
163: Set cntTemp = clsAnchor.cnt
174-
164: If clsAnchor.AnchorStyle = enumAnchorStyleNone Then
175-
165: ' do nothing with this control
176-
166: Else
177-
167: If ((clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop) And _
178-
((clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom) Then
179-
169: ' maintain gap between top and bottom edges by adjusting height
180-
170: sngHeight = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigTop
181-
171: If sngHeight < clsAnchor.MinimumHeight Then sngHeight = clsAnchor.MinimumHeight
182-
172: If sngHeight < 0 Then sngHeight = 0
183-
173: cntTemp.Height = sngHeight
184-
174: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop Then
185-
175: ' maintain gap between top leave height alone
186-
176: ' does not require code
187-
177: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom Then
188-
178: ' maintain gap between bottom leave height alone
189-
179: sngTop = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigHeight
190-
180: If sngTop < clsAnchor.MinimumTop Then sngTop = clsAnchor.MinimumTop
191-
181: If sngTop < 0 Then sngTop = 0
192-
182: cntTemp.top = sngTop
193-
183: End If
194-
184: If ((clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft) And _
195-
((clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight) Then
196-
186: ' maintain gap between left and right edges by adjusting Width
197-
187: sngWidth = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigLeft
198-
188: If sngWidth < clsAnchor.MinimumWidth Then sngWidth = clsAnchor.MinimumWidth
199-
189: If sngWidth < 0 Then sngWidth = 0
200-
190: cntTemp.Width = sngWidth
201-
191: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft Then
202-
192: ' maintain gap between left leave Width alone
203-
193: ' does not require code
204-
194: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight Then
205-
195: ' maintain gap between Right leave Width alone
206-
196: sngLeft = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigWidth
207-
197: If sngLeft < clsAnchor.MinimumLeft Then sngLeft = clsAnchor.MinimumLeft
208-
198: If sngLeft < 0 Then sngLeft = 0
209-
199: cntTemp.Left = sngLeft
210-
200: End If
211-
201: End If
212-
202: Next
213-
203: DoEvents
214-
End Sub
166+
154: Dim clsAnchor As CAnchor
167+
155: Dim cntTemp As MSForms.control
168+
156: Dim sngLeft As Single
169+
157: Dim sngTop As Single
170+
158: Dim sngHeight As Single
171+
159: Dim sngWidth As Single
172+
160: For Each clsAnchor In m_colAnchors
173+
161: Set cntTemp = clsAnchor.cnt
174+
162: If clsAnchor.AnchorStyle = enumAnchorStyleNone Then
175+
163: ' do nothing with this control
176+
164: Else
177+
165: If ((clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop) And _
178+
((clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom) Then
179+
167: ' maintain gap between top and bottom edges by adjusting height
180+
168: sngHeight = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigTop
181+
169: If sngHeight < clsAnchor.MinimumHeight Then sngHeight = clsAnchor.MinimumHeight
182+
170: If sngHeight < 0 Then sngHeight = 0
183+
171: cntTemp.Height = sngHeight
184+
172: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop Then
185+
173: ' maintain gap between top leave height alone
186+
174: ' does not require code
187+
175: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom Then
188+
176: ' maintain gap between bottom leave height alone
189+
177: sngTop = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigHeight
190+
178: If sngTop < clsAnchor.MinimumTop Then sngTop = clsAnchor.MinimumTop
191+
179: If sngTop < 0 Then sngTop = 0
192+
180: cntTemp.top = sngTop
193+
181: End If
194+
182: If ((clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft) And _
195+
((clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight) Then
196+
184: ' maintain gap between left and right edges by adjusting Width
197+
185: sngWidth = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigLeft
198+
186: If sngWidth < clsAnchor.MinimumWidth Then sngWidth = clsAnchor.MinimumWidth
199+
187: If sngWidth < 0 Then sngWidth = 0
200+
188: cntTemp.Width = sngWidth
201+
189: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft Then
202+
190: ' maintain gap between left leave Width alone
203+
191: ' does not require code
204+
192: ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight Then
205+
193: ' maintain gap between Right leave Width alone
206+
194: sngLeft = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigWidth
207+
195: If sngLeft < clsAnchor.MinimumLeft Then sngLeft = clsAnchor.MinimumLeft
208+
196: If sngLeft < 0 Then sngLeft = 0
209+
197: cntTemp.Left = sngLeft
210+
198: End If
211+
199: End If
212+
200: Next
213+
201: DoEvents
214+
202: End Sub

0 commit comments

Comments
 (0)