AW: CommandButton
08.08.2003 15:55:44
Andi_H
Hi Wang,
hab des jetzt mal abgeändert so wie ich das machen würde. Einen CommandButton mit Code füllen habe ich nicht hinbekommen. Das Makro erstellt jetzt ein Shape anstatt CB und weist diesem dann ein Makro zu.
Schau dir das mal an ob du dir sowas in der art vorgestellt hast.
Die Formatierung des Shapes habe ich aufgezeichnet, bei der Hitze muß man auch mit geistiger anstrengung sparen.
Sub Insert()
Dim inputDateiname As String
aktuelleDateiname = ActiveWorkbook.Name
Nr = Sheets.Count
Application.Dialogs(xlDialogOpen).Show
inputDateiname = ActiveWorkbook.Name
If inputDateiname = (aktuelleDateiname) Then Exit Sub
Sheets(1).Select
Sheets(1).Name = "Input_Tabelle"
Sheets("Input_Tabelle").Copy After:=Workbooks(aktuelleDateiname).Sheets(Nr)
Workbooks(inputDateiname).Close savechanges:=False
Nu = Sheets.Count - 2
For Each Blatt In Sheets
sheetname = Blatt.Name
If sheetname = "Messdata" Then
Sheets(sheetname).Name = "Messdata" & Nu
Exit For
End If
Next
Sheets("Input_Tabelle").Select
Sheets("Input_Tabelle").Name = "Messdata"
Sheets("Messdata").Move After:=Workbooks(aktuelleDateiname).Sheets("Parameter")
' mit commandbutton hab ich des nicht hinbekommen, als Zeichnungsobjekt gehts mit Makro zuweisen
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 268.5, 9.75, 121.5, 28.5). _
Select
Selection.OnAction = "UnionCommands"
Selection.Characters.Text = "CommandButton1"
ActiveSheet.Shapes("Rectangle 1").Select
With Selection.Font
.NAME = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.AutoSize = False
End With
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 55
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
' zeilen fixieren
Rows(4).Select
ActiveWindow.FreezePanes = True
Sheets(1).Select
Sheets(1).Move after:=Sheets("Tabelle3")
I = 1
For Each Blatt In Sheets
Range("A" & I) = Blatt.Name
I = I + 1
Next
End Sub
Gruß
Andi