12.07.2018, 08:48
Hallo,
über folgenden Button lese ich Daten aus anderen Excel-Dateien ein. Nach einmaligem Einlesen funktionieren danach noch die Makros auf dem Arbeitsblatt, sodass Berechnungen ausgeführt werden können. Führt man den Button jedoch zwei Mal aus, sind die anderen Makros wie ausgeschaltet. Nun möchte ich, dass der Button nur einmal betätigt werden soll/kann, sodass dieses Problem nicht mehr auftreten kann.
Ich habe es mit dem Objekt b in meinem Code versucht, jedoch funktioniert das leider nicht. Den Namen "Button 40" habe ich über den Makrorekorder erhalten. Der Code ist ein wenig unübersichtlich, primär geht es mir darum, das Problem zu lösen. Vielen Dank schonmal :)
über folgenden Button lese ich Daten aus anderen Excel-Dateien ein. Nach einmaligem Einlesen funktionieren danach noch die Makros auf dem Arbeitsblatt, sodass Berechnungen ausgeführt werden können. Führt man den Button jedoch zwei Mal aus, sind die anderen Makros wie ausgeschaltet. Nun möchte ich, dass der Button nur einmal betätigt werden soll/kann, sodass dieses Problem nicht mehr auftreten kann.
Ich habe es mit dem Objekt b in meinem Code versucht, jedoch funktioniert das leider nicht. Den Namen "Button 40" habe ich über den Makrorekorder erhalten. Der Code ist ein wenig unübersichtlich, primär geht es mir darum, das Problem zu lösen. Vielen Dank schonmal :)
Code:
Sub DatenEinlesenColorado()
Dim b As Button
Set b = ActiveSheet.Buttons("Button 40")
On Error Resume Next
Application.EnableEvents = False
If Range("A3").Value = "" Then
'Einlesen der Daten für die Spalten A bis M, sowie die Spalte AG
Call Readpersnr
Call Nameconvert
Call ReadEintritt
Call ReadDST
Call Readgeb
Call AlterEinlesen
Call DienstjahrFormelEinlesen
'Einlesen und gleichzeitiges kopieren der "Zukünftigen Daten" und der "Aktuellen Daten". Zudem werden Berechnungen angestoßen um Spaltenwerte zu ermitteln
Call ReadEG
Call ReadIRWAZSTD
Call Convertabcde
Call ReadLBUSZ
Call EGGehalt
Call ReadEGGehalt
Call platzhalter
Call LBProzentEinlesen
Call LBEinlesen
Call MEKhEinlesen
Call irwazEinlesen
Call JEK
Call DeltaMEK35berechnen
Call DeltaMEKIrwazberechnen
Call DeltaMEKProzent
Call mdlPotential
Call mdlRollen
Application.EnableEvents = True
On Error GoTo 0
'Erstellung DropDown-Menü
Set book1 = ActiveWorkbook
With book1.Worksheets("Gehaltsdaten").Range("P3:P1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
.ErrorMessage = "Geben Sie bitte eine Zahl zwischen 1 und 17 ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("T3:T1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("U3:U1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("V3:V1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("W3:W1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("X3:X1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
With book1.Worksheets("Gehaltsdaten").Range("Y3:Y1000").Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="A,B,C,D,E"
.ErrorMessage = "Geben Sie bitte eine Bewertung von A bis E ein!"
End With
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
'Einlesen der Daten aus der Vorjahrestabelle
Dim instring1 As String
Dim instring2 As String
Dim instring3 As String
Dim instring4 As String
Dim instring5 As String
Dim instring6 As String
Dim outstring() As String
Dim book, mybook As Workbook
Dim sourceline, destinationline As Integer
Dim Pfad As String
Dim location As String
Dim Identification As Long
Dim Help As Range
Dim Zeile1 As Integer
Set mybook = ActiveWorkbook
Pfad = (mybook.Worksheets("Parameter").Cells(2, 1))
Set book = Workbooks.Open(Filename:=Pfad, ReadOnly:=True)
sourceline = 3
destinationline = 3
Set Help = mybook.Worksheets("Gehaltsdaten").Range("A3:A3000")
On Error GoTo Fehler
While (destinationline < 1000)
'Nimmt die Personalnummer aus der Lasche "Mitarbeiterdaten" und ordnet die entsprechenden Daten anschliesen der richtigen Nummer in der Gehaltstabelle zu
With book.Worksheets("Gehaltsdaten")
Identification = .Cells(destinationline, 1)
instring1 = .Cells(destinationline, 9) 'Spalte I
instring2 = .Cells(destinationline, 10) 'Spalte J
instring3 = .Cells(destinationline, 11) 'Spalte K
instring4 = .Cells(destinationline, 12) 'Spalte L
instring5 = .Cells(destinationline, 13) 'Spalte M
instring6 = .Cells(destinationline, 33) 'Spalte AG
End With
location = WorksheetFunction.Match(Identification, Help, 0)
location = location + 2
With mybook.Worksheets("Gehaltsdaten")
.Cells(location, 9) = instring1
.Cells(location, 10) = instring2
.Cells(location, 11) = instring3
.Cells(location, 12) = instring4
.Cells(location, 13) = instring5
.Cells(location, 33) = instring6
End With
Sprung:
destinationline = destinationline + 1
sourceline = sourceline + 1
Wend
For Zeile1 = 3 To 1000
With mybook.Worksheets("Gehaltsdaten").Cells(Zeile1, 13).Validation
.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="1 - Übertrifft die Erwartungen, 2 - Erfüllt die Erwartungen, 3 - Erfüllt nicht die Erwartungen"
.ErrorMessage = "Geben Sie bitte ein Ranking zwischen 1 und 3 ein!"
End With
Next Zeile1
MsgBox "Die Daten wurden eingelesen!", vbInformation
book.Close savechanges:=False
Exit Sub
Fehler:
Resume Sprung
Else
MsgBox "Daten wurden bereits eingelesen!", vbInformation
End If
b.Enabled = False
End Sub
