AW: Aus UF CommandButton in Sheets eine Schaltfläche a
25.11.2012 11:41:32
Heinz
Hallo Karin
Den unteren Code habe ich in einen allg.Modul.
Die Schaltfäche ist ein Formular-Steurelement
Ich müsste den ganzen Code umschreiben. So wäre es am einfachsten.
Gruß Heinz
Option Explicit
Option Private Module 'Diese Option aktivieren, nachdem die Makros den Schaltflächen _
zugewiesen sind
Sub Schichtwechsel_Einfuegen()
Dim ZeileShape As Long, wks As Worksheet, wksMonat As Worksheet
Dim Spalte As Long, Zeile As Long, sName As String, sMonat As String, sSchicht As String
Dim StatusCalc As Long
Call BlattSchutz_Aufheben
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo Fehler
Set wks = ActiveSheet
ZeileShape = wks.Shapes(Application.Caller).TopLeftCell.Row 'Zeile mit der angeklickten _
Schaltfläche
With wks
Zeile = .Cells(ZeileShape + 1, 1)
sName = .Cells(ZeileShape + 2, 1)
sMonat = .Cells(ZeileShape, 1) 'geändert fcs _
20120421
sSchicht = .Cells(ZeileShape, 2) 'geändert fcs _
20120421
If MsgBox("Inhalte in Zeile " & Zeile & " im Blatt """ & sMonat & """ überschreiben?", _
vbQuestion + vbYesNo, _
"Schichtwechsel - Zeileninhalte löschen") = vbNo Then GoTo Fehler
Set wksMonat = Worksheets(sMonat)
wksMonat.Cells(Zeile, 1).Value = sName
wksMonat.Cells(Zeile, 2).Value = sSchicht
For Spalte = 3 To .Range("AG1").Column
If .Cells(ZeileShape + 2, Spalte) 0 Then
wksMonat.Cells(Zeile, Spalte).Value = .Cells(ZeileShape + 2, Spalte)
Else
wksMonat.Cells(Zeile, Spalte).ClearContents
End If
Next
End With
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Call BlattSchutz_Ein
With Application
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub