Einweg-Button

[JonasRe]

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 :)

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

[Matthias84]

Hallo,

drei Lösungsmöglichkeiten fallen mir dazu ein:

1.) Deklaration einer statischen Variablen

2.) Du prüfst am Anfang des Codes, ob z.B. eine Zelle gefüllt ist, die nur dann gefüllt ist, wenn dein Code bereits einmal lief

3.) Du blendest den Button am Ende des Codes aus, bzw. setzt ihn auf inaktiv

Gruß,
Matthias

[Steffl]

Hallo Jonas,

sezte dir einen Haltepunkt (F9-Taste) und zwar genau hier

Code:

Set b = ActiveSheet.Buttons("Button 40")

Lies dir zum Haltepunkt auch diesen Artikel von Peter Haserodt durch. Gehe mit der F8-Taste durch den Code und mache das beim zweiten Mal auch. Siehst Du dann, wie der Code von Excel abgearbeitet wird.

[JonasRe]

Hallo ihr beiden,

danke schon mal für die Hilfestellungen.

@Steffl, ich habe gesehen, dass "b.Enabled = False" zu spät gesetzt wurde, sodass es unnütz ist?!

@Matthias84, ich habe deine Lösungsmöglichkeitnummer 2 versucht, da mir dazu eine Umsetzung eingefallen ist, die leider nicht so geklappt hat wie ich es mir vorgestellt habe. Ich wollte prüfen, ob die erste Zelle schon gelesen wurde. Falls ja, dann soll der Button nicht mehr aktivierbar sein. Den Ausschnitt setzte ich hier mal drunter.

Code:

Dim b As Button
Set b = ActiveSheet.Buttons("Button 40")

If Range("A3").Value <> "" Then
   b.Enabled = False
End If

Ich bin fachfremd und daher fällt es mir ein wenig schwer eure Hilfen umzusetzen.

[Matthias84]

Hallo,

wenn du dich mit VBA nicht auskennst, bietet Excel mit Power Query mittlerweile eine sehr interessante Importmöglichkeit für Daten aus anderen Dateien - und das beste, du musst nicht eine Zeile programmieren.

[JonasRe]

@Matthias, danke für den Hinweis, jedoch muss ich es denke mit VBA lösen.

Der Hintergrund ist, dass ich eine Werkstudentenstelle angenommen habe und von einem Vorgänger die Codes übernommen habe und diese fertigstellen soll bis zum Wochenende. Sprich, ich habe eine Grundlage übergeben bekommen, die ich jetzt nicht so schnell abändern kann. Das Programm ist auch in den Endzügen soweit, nur die Sache mit dem Button ist noch einer der letzten Puzzlestücke, daher wäre ich über eine Lösung über VBA sehr dankbar.

Sei mir bitte nicht böse, aber in Anbetracht der Rahmenbedingungen wäre es hilfreicher das in den integrierten Code einzufügen? Korrigiere mich gerne, falls ich falsch liege. Ich danke dir für deine Hilfe!

[Kuwer]

Hallo,

vielleicht einfach so:

Sub DatenEinlesenColorado()
 ActiveSheet.Buttons(Application.Caller).Visible = False

 '...
End Sub

Gruß Uwe

[Matthias84]

Das nächste mal würde ich an deiner Stelle mir überlegen, ob du eine Aufgabe auch ausführen kannst, bevor du sie annimmst...

Probier mal am Anfang des Codes

Code:

If Range("A3").Value <> "" Then Exit Sub

Vorausgesetzt dein makro soll nur dann laufen, wenn Zelle A3 leer ist.

[JonasRe]

Vielen Dank euch beiden @Kuwer und @Matthias

Ja da stimmte ich dir zu. Ich will VBA lernen und konnte bisher schon einiges machen, aber da habe ich den Aufwand ein wenig unterschätzt bzw. die Anforderungen.