Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
24.08.2017 09:59:38 |
Stefan |
|
|
|
24.08.2017 11:16:31 |
Gast74502 |
|
|
|
24.08.2017 12:28:34 |
Stefan |
|
|
Command Buttons iterativ mit Makros verknüpfen |
24.08.2017 19:13:24 |
Gast70117 |
|
|
Von:
Gast70117 |
Datum:
24.08.2017 19:13:24 |
Views:
585 |
Rating:
|
Antwort:
|
Thema:
Command Buttons iterativ mit Makros verknüpfen |
Quick&Dirty
Option Explicit
Sub Test()
'ACHTUNG Verweise ----------------------------------------
'Microsoft Visual Basic For Applications Extensibility 5.3
'---------------------------------------------------------
Const myClassType As String = "Forms.CommandButton.1"
Const myWidth As Single = 120
Const myHeight As Single = 24
Dim z As Integer, i As Integer, anz As Integer
Dim myTop, myLeft As Single
Dim oOle As OLEObject
z = CountIt()
If z > 0 Then myTop = NewTop(myHeight)
On Error Resume Next
anz = InputBox("Anzahl neuer Buttons : ", CStr(z) & " Buttons vorhanden ", 1)
If Not IsNumeric(anz) Or anz = 0 Then Exit Sub
On Error GoTo 0
For i = 1 To anz
Set oOle = ActiveSheet.OLEObjects.Add _
(ClassType:=myClassType, _
Left:=myLeft, Top:=myTop, Width:=myWidth, Height:=myHeight)
If AddMacro(oOle.Name) = False Then oOle.Delete
myTop = myTop + myHeight + 2
myLeft = myLeft + myWidth + 10
Next i
End Sub
Private Function CountIt() As Integer
Dim oOle As OLEObject
Dim i As Integer
For Each oOle In ActiveSheet.OLEObjects
If oOle.progID = "Forms.CommandButton.1" Then i = i + 1
Next oOle
CountIt = i
End Function
Private Function NewTop(myHeight As Single)
Dim myTop As Single
Dim oOle As OLEObject
For Each oOle In ActiveSheet.OLEObjects
If oOle.progID = "Forms.CommandButton.1" Then myTop = myTop + myHeight + 2
Next oOle
NewTop = myTop
End Function
Private Function AddMacro(myName As String) As Boolean
Const myLine1 As String = "Private Sub CBX_Click()"
Const myLine2 As String = "End Sub"
On Error GoTo fail:
'Sub CreateEventProcedure()
'http://www.cpearson.com/excel/vbe.aspx
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ActiveSheet.Name)
Set CodeMod = VBComp.CodeModule
'ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).Activate
With CodeMod
LineNum = .CreateEventProc("Click", myName)
LineNum = LineNum + 1
.InsertLines LineNum, " MsgBox " & DQUOTE & myName & DQUOTE
End With
'End Sub
fail:
If Err.Number = 0 Then AddMacro = True
End Function
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
24.08.2017 09:59:38 |
Stefan |
|
|
|
24.08.2017 11:16:31 |
Gast74502 |
|
|
|
24.08.2017 12:28:34 |
Stefan |
|
|
Command Buttons iterativ mit Makros verknüpfen |
24.08.2017 19:13:24 |
Gast70117 |
|
|