Office: Schleife für Array Problem mit Textbox-Bezeichnung

Hallo miteinander,

Heute ist mein Problem von geringerer Natur. Dank des Forums bin ich in den letzten Wochen mit meinem kleinen Projekt gut vorangekommen. Jetzt würde ich aber doch gerne noch eines wissen.

Ich habe untenstehenden Code von einem anderen Projekt übernehmen können suche nun nach einem weg das ganze abzukürzen.

Code:

Private Sub cmdRechnungErstellen_Click()
'Speichern der Rechnungsdaten in der Datenbank + Übertrag der Daten in das Rechnungsformular
Dim XY_lngZeile As Long
Dim rngKuZelle As Range
Dim rgWS As Worksheet
Dim K As Integer
Dim BK As Integer
Dim Spalte1 As Integer
Dim Spalte2 As Integer
Dim Spalte3 As Integer
Dim Spalte4 As Integer
Dim i As Integer
Dim posCount As Integer
Dim arrAb As Variant
Dim insLine As Variant
Dim TT As Variant
Dim Y As Integer
 
 ' ALS ERSTES TEMP setzen für Rechnungs Teil 2
 temp1 = 10

'#########-------------------- TEIL 3 Übertrag ins Rechnungsformular-----------##########


'Kopieren des Sheets -> erstmal zum testen erlaubt
Worksheets("Rechnung").Copy After:=Sheets(5)
ActiveSheet.Name = "RG-" & Me.txtName & Int((1000 - 0 + 1) * Rnd + 0)
Set rgWS = ActiveSheet
ActiveSheet.Visible = True

'Übernahme der "Rechnungskopfdaten"
With rgWS
    .Range("kdName") = "Herr" & " " & txtName
    .Range("kdWohnadresse") = txtStraße
    .Range("KdWohnort") = "D-" & txtPLZ & " " & txtStadt
    .Range("kdLand") = "Deutschland"
    .Range("kdNummer") = txtKundennummer
    .Range("RgDatum") = txtReDatum
    .Range("rgnummer") = txtReNummer.Value

'-------------------------------------------Übernahme der Leistung

'Position 1
    If Me.txtBez1 <> "" And txtZw1 > 0 Then 
    arrAb = Array(posCount, "", txtBez & 1, txtMenge & 1, txtP & 1) 
    .Range("rgStart").Resize(2, 6).Activate 
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      insLine = .Range("RgStart").Row - 2
        For i = 0 To UBound(arrAb)
            .Cells(insLine, i + 1) = arrAb(i)
        Next
      .Cells(insLine, i + 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
      posCount = posCount + 1
    End If

    With .Range("kdName", "RgTextZus")
        .Rows.AutoFit
    End With

'Position 2
    If Me.txtBez2 <> "" And txtZw2 > 0 Then 
    arrAb = Array(posCount, "", txtBez & 2, txtMenge & 2, txtP & 2) 
    .Range("rgStart").Resize(2, 6).Activate 
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      insLine = .Range("RgStart").Row - 2
        For i = 0 To UBound(arrAb)
            .Cells(insLine, i + 1) = arrAb(i)
        Next
      .Cells(insLine, i + 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
      posCount = posCount + 1
    End If

    With .Range("kdName", "RgTextZus")
        .Rows.AutoFit
    End With

.
. Wiederholung der Blöcke bis Block 16
.


'Position 16
    If Me.txtBez16 <> "" And txtZw16 > 0 Then 
    arrAb = Array(posCount, "", txtBez & 16, txtMenge & 16, txtP & 16) 
    .Range("rgStart").Resize(2, 6).Activate 
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      insLine = .Range("RgStart").Row - 2
        For i = 0 To UBound(arrAb)
            .Cells(insLine, i + 1) = arrAb(i)
        Next
      .Cells(insLine, i + 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
      posCount = posCount + 1
    End If

    With .Range("kdName", "RgTextZus")
        .Rows.AutoFit
    End With

End With
End With
End Sub

Der code funktioniert und ich werde ihn auch erst einmal so lassen (gewünschte funktion wird ausgeführt). Nur habe ich mich (leider zu spät) gefragt ob ich das ganze nicht abkürzen kann.
Da die bezeichnungen immer die selben sind und sich nur die Zahlen im Name ändern, dachte ich mir es über eine Schleife zu lösen.
Problem ist nun dass ich die textboxen nicht gestückelt, also nach name und nummer, ansprechen kann. Somit erkennt VBA das "&" und die nummer nicht. Für Excel steht ja nur txtBez da. und das gibt es ja nicht. Es gibt ja nur txtBez1, txtBez2, etc...
Somit ist was mich jetzt von der Lösung trennt die korrekte Schreibweise für die Textbox inkl. der Schleifenzahl.

hat da jemand vielleicht eine Idee? Konkret beginnt das Prblem ganz oben hier:

Code:

For Y = 1 To 16
    If Me.txtBez & Y <> "" And txtZw & Y > 0 Then

Und hier mein Ansatz über die schleife:

Code:

Private Sub cmdRechnungErstellen_Click()
'Deklaration ist die selbe

'Kopieren des Sheets -> erstmal zum testen erlaubt
Worksheets("Rechnung").Copy After:=Sheets(5)
ActiveSheet.Name = "RG-" & Me.txtName & Int((1000 - 0 + 1) * Rnd + 0)
Set rgWS = ActiveSheet
ActiveSheet.Visible = True

'Übernahme der "Rechnungskopfdaten"
With rgWS
    .Range("kdName") = "Herr" & " " & txtName
    .Range("kdWohnadresse") = txtStraße
    .Range("KdWohnort") = "D-" & txtPLZ & " " & txtStadt
    .Range("kdLand") = "Deutschland"
    .Range("kdNummer") = txtKundennummer
    .Range("RgDatum") = txtReDatum
    .Range("rgnummer") = txtReNummer.Value

'-------------------------------------------Übernahme der Leistung

'Position 1
For Y = 1 To 16
    If Me.txtBez & Y <> "" And txtZw & Y > 0 Then 'Prüfunge ob Position ausgewählt werden soll
    arrAb = Array(posCount, "", txtBez & Y, txtMenge & Y, txtP & Y) ' was muss ins array?
    .Range("rgStart").Resize(2, 6).Activate 'Makro legt los
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      insLine = .Range("RgStart").Row - 2
        For i = 0 To UBound(arrAb)
            .Cells(insLine, i + 1) = arrAb(i)
        Next
      .Cells(insLine, i + 1).FormulaR1C1 = "=RC[-2]*RC[-1]"
      posCount = posCount + 1
    End If

    With .Range("kdName", "RgTextZus")
        .Rows.AutoFit
    End With

End With
End With
'End Sub

Noch eine Zusatzfrage:
Variablen als "Variant" zu deklarieren ist für mich mittlerweile ein kleines Hintertürchen geworden wenn ich keine ahnung habe wie der korrekte datentyp lauten soll. Das soll aber nicht einreißen. Deshalb wollte ich noch fragen ob mir jemand helfen könnte "arrAb", "TT" und "insLine" zu deklarieren.

Freundliche Grüße und ein schönes Wochenende

Nico

 

Hallo Nico,

ich nehme an, dass Dein Code in etwa so lauten sollte:

Code:

Public Sub cmdRechnungErstellen_Click()
'Speichern der Rechnungsdaten in der Datenbank + Übertrag der Daten in das Rechnungsformular
Dim XY_lngZeile As Long
Dim rngKuZelle As Range
Dim rgWS As Worksheet
Dim K As Integer
Dim BK As Integer
Dim Spalte1 As Integer
Dim Spalte2 As Integer
Dim Spalte3 As Integer
Dim Spalte4 As Integer
Dim i As Integer
Dim posCount As Integer
Dim Y As Integer
Dim temp1 As Integer
 
 ' ALS ERSTES TEMP setzen für Rechnungs Teil 2
temp1 = 10

'#########-------------------- TEIL 3 Übertrag ins Rechnungsformular-----------##########


'Kopieren des Sheets -> erstmal zum testen erlaubt
Worksheets("Rechnung").Copy After:=Sheets(5)
ActiveSheet.Name = "RG-" & Me.txtName & Int((1000 - 0 + 1) * Rnd + 0)
Set rgWS = ActiveSheet
ActiveSheet.Visible = True

'Übernahme der "Rechnungskopfdaten"
With rgWS
    .Range("kdName") = "Herr" & " " & txtName
    .Range("kdWohnadresse") = txtStraße
    .Range("KdWohnort") = "D-" & txtPLZ & " " & txtStadt
    .Range("kdLand") = "Deutschland"
    .Range("kdNummer") = txtKundennummer
    .Range("RgDatum") = txtReDatum
    .Range("rgnummer") = txtReNummer.Value

'-------------------------------------------Übernahme der Leistung

'Position 1-16
    posCount = 1
    For Y = 1 To 16
      If Me("txtBez" & Y) <> "" And Me("txtZwi" & Y) > 0 Then
        With .Range("rgStart").Resize(2, 6)
          .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          With .Offset(-2)
            .Cells(1) = posCount
            .Cells(2) = ""
            .Cells(3) = Me("txtBez" & Y).Value          'Variante 1
            .Cells(4) = Me.Controls("txtMenge" & Y)     'Variante 2
            .Cells(5) = Me("txtP" & Y)                  'Variante 3
            .Cells(6).FormulaR1C1 = "=RC[-2]*RC[-1]"
          End With
        End With
        posCount = posCount + 1
      End If
  
     .Range("kdName", "RgTextZus").Rows.AutoFit
      
    Next Y

End With

End Sub

Ich habe den Code bewusst etwas umgeschrieben, damit nämlich kein "Selection"-Objekt mehr vorkommt. Dieses sollte man nämlich möglichst vermeiden, weil es den Makroablauf verlangsamt, da jedesmal bei seinem Auftreten der Bildschirm aktualisiert werden muss - und das dauert eben seine Zeit.

Den Einsatz von "Array(...)" halte ich für überflüssig, denn man gewinnt an dieser Stelle damit nichts, außer dass der Code schwerer zu verstehen ist.

Damit hat sich auch die Frage nach der Deklaration von "arrAb" bzw. "insLine" erledigt. Bezüglich "TT" kann ich nichts sagen, denn sie kommt in diesem Code nicht vor.

 

Hallo Anton,

wie immer funktioniert deine Lösung einwandfrei. Danke auch für die erklärung des "Selection"-Befehls. Ich bin immer ein freund von "schlanker" programmierung. Ich bedanke mich auch für die 3 Varianten um mir zu verdeutlichen welche Wege nach Rom führen.
das mit der Variablen TT ist leicht zu erklären. Ich hatte versehentlich die falsche version kopiert. Also nach dem ertellen der Rechnung soll folgendes stehen:

Code:

'Abfrage ob weitergemacht werden soll
TT = MsgBox("Vorgang jetzt abbrechen und Rechnung Ansehen?", vbQuestion + vbYesNo)
If TT = vbYes Then
    Unload ReProg
    Sheets(6).Activate
    Exit Sub
ElseIf TT = vbNo Then
    Exit Sub
End If

Ich muss gestehen hier bin ich mit dem Latein am Ende. Ich frage ja keinen Wert im klassischen Sinne ab, somit sind Integer, Single, Double, String schon mal raus. Object, worksheet, range, etc. auch... Was bleibt denn dann noch als datentyp übrig?

Gruß und noch einmal vielen Dank

 

Hallo Nico,

TT besitzt einen vordefinierten Aufzählungstyp (Enumeration) "VbMsgBoxResult", d.h. die möglichen Werte dieses Typs sind ebenfalls vordefiniert wie folgt:

Code:

  Dim TT As VbMsgBoxResult
  TT = MsgBox(......)
'  TT = vbAbort    '=3
'  TT = vbCancel   '=2
'  TT = vbIgnore   '=5
'  TT = vbNo       '=7
'  TT = vbOK       '=1
'  TT = vbRetry    '=4
'  TT = vbYes      '=6

Deklariert man eine Variable mit diesem Typ, bekommt man bei Wertzuweisungen an eine solche Variable automatisch eine Liste ihrer möglichen Werte angeboten (wie ich sie vorhin dargestellt habe).

 

Hallo Anton,

vielen herzlichen Dank. So etwas in der Art habe ich mir schon gedacht. Mit der Deklaration:

Code:

 Dim TT As VbMsgBoxResul

klappt es einwandfrei.

Da jetzt mit der Schleife das Kernproblem gelöst ist, würde ich gerne noch auf einen "bug" in meinem Projekt zurück kommen der schon länger da ist, aber erst jetzt an priorität gewinnt.
Es geht um die Erstellung der Rechnungs u. Angebotsnummer. Durch dieses Forum habe ich eine Methode bekommen die Rechnugnsnummer zu erstellen. Ich benötigte jedoch auch eine Methode für die Angebotsnummer. Also habe ich die Methode übernommen und versucht im Code anzupassen.
Leider hat meine Originaldatei mittlerweile 1,5Mb und ich kann nur einen Ausschnitt hochladen aber wenn du dir das Beispiel einmal ansehen könntest wäre ich dir sehr dankbar.

Zuerst soll man in der userform Die Auftragskategorie (Angebot o. Rechnung) auswählen. Dann den Buchungskreis. Somit erscheint die Nummer. Wenn nun die auftragskategorie fest bleibt und die BuKr. sich durch anklicken verändern, funktioniert das einwandfrei. Wie du feststellen kannst funktioniert das so lange einwandfrei, bis man die auftragskategorie wechseln möchte. Dann kommt ein fehler.
Interessanter weise tritt der fehler nicht auf wenn ich in beiden private sub's der option buttons z.b. eine checkbox (checkbox1) = true setze. Einfachste Lösung. Ich lasse das so. Beste Lösung ist aber dass alle checkboxen danach wieder "leer" oder false sind.
Das ist notwendig um die Eingabe weiter abzusichern. Später im Programm mache ich nämlich eine Abfrage ob eine der Checkboxen angewählt wurde. Das ist wichtig. diese Abfrage ist dann nämlich umsonst wenn ich immer z.b. checkbox 1 anwähle.

Hast du eine Idee woran das liegen könnte? Und bitte keine Eile. Ein jeder soll seinen Sonntag genießen dürfen. herzlichen Dank im vor raus.

Nico

 

Hallo Nico,

Das stimmt so.
In den Click-Ereignisprozeduren für die beiden Auftragskategorien (Angebot, Rechnung) hast Du folgende identische Anweisungsabfolge stehen:

Code:

'...
        txtReNummer.Text = ""
        cbxBehelf.Value = True
        cbxBuKr1.Value = False
        cbxBuKr2.Value = False
        cbxBuKr3.Value = False
'...

1) Das sind fürs Erste 5 Wertzuweisungen. Aber es sind nicht bloß 5 Wertzuweisungen an 5 Steuerelemente des Formulars. Denn:

2) Angenommen es war vor dem Klicken auf einen der beiden Radiobuttons (Angebot/Rechnung) die Checkbox "Buchungskreis 1" (cbxBuKr1) angehakt. Damit hatte die Value-Eigenschaft von cbxBuKr1 den Wert "True". Durch vorgenannte Codesequenz wird der Wert dieser Eigenschaft jedoch auf "False" gesetzt. In diesem Augenblick wird aber für dieses Steuerelement (cbxBuKr1) nicht bloß das Change-Ereignis, sondern auch das Click-Ereignis ausgelöst (lt. Hilfeinformation von Microsoft). Da Du eine Ereignisbehandlungroutine für das Click-Ereignis von cbxBuKr1 programmiert hast (Private Sub cbxBuKr1_Click()), wird diese sofort nach Ausführung der Wertzuweisung "cbxBuKr1.Value = False" ausgeführt.

3) Zu diesem Zeitpunkt haben aber alle 3 cbxBuKrX den Value-Wert "False", ebenso ist die Text-Eigenschaft von txtReNummer ="". Dadurch wird die lokale Variable "BkAuswahl" durch Abfrage der Funktion "BkSelected" bzw. "BkSelected2" auf 0 gesetzt. Dieser 0-Wert wird dann an eine der Funktionen "NewNumberRe(0)" bzw. "NewNumberAng(0)" übergeben. Schaut man dann dort nach, was passiert - so kann das nicht gut gehen. Dort wird nämlich eine Zellenabfrage des Arbeitsblattes "Versteckt" ausgeführt mit ".Cells(9,BK)" bzw. ".Cells(2,BK)", wobei eben diese "BK" den Wert 0 hat. Eine solche Zelle ".Cells(9,0)" bzw. ".Cells(2,0)" gibt es im Arbeitsblatt nicht - und deshalb kommt es zur Programmunterbrechung mit Fehlermeldung.

4) Um dieses Problem zu vermeiden, musst Du in den 3 Click-Event-Handlern "cbxBuKr1_Click()", ... 2 Zeilen eingefügen. Stellvertretend führe ich die Anweisungssequenz für "cbxBuKr1_Click()" an:

Code:

Private Sub cbxBuKr1_Click()
   Dim BkAuswahl As Integer
    If cbxBuKr1 = True Then
        txtReNummer = ""
        cbxBehelf.Value = False
        cbxBuKr2 = False
        cbxBuKr3 = False
[COLOR="#FF0000"]    Else
        Exit Sub[/COLOR]    
    End If
 
    If txtReNummer = "" Then
        If optRechnung = True Then
            BkAuswahl = BkSelected
            txtReNummer = NewNumberRe(BkAuswahl)
        ElseIf optAngebot = True Then
            BkAuswahl = BkSelected2
            txtReNummer = NewNumberAng(BkAuswahl)
        ElseIf optRechnung = False And optAngebot = False Then
            MsgBox ("Bitte Auftragskategorie UND Buchungskreis auswŠhlen")
        End If
    Else
    End If
End Sub

In den beiden anderen Ereignisprozeduren "cbxBuKr2_Click()" und "cbxBuKr3_Click()" musst Du die beiden roten Zeilen ebenso ergänzen, dann gibt es keine Probleme mehr.

 

Hallo Anton,

wow da wäre ich im leben nicht drauf gekommen. Aber ist ja logisch. Beim "anklicken" und "aufheben-anklicken" habe ich ein "click" ereignis. Das hatte ich gar nicht bedacht. Was ich auch nicht wusste (etwas peinlich dass ich nicht selbst drauf gekommen bin) ist die Tatsache warum immer die Zeile mit
".Cells(9,BK)" oder ".Cells(2,BK)"
aufgeleuchtet hat. Aber natürlich wurde für BK kein wert zugewiesen. Ich stelle bei mir durchaus noch defizite fest sobald die programmierung zwischen mehreren subs und in verschiedenen Ebenen herumspringt.

Ich bin auch immer wieder über die einfachheit und präzision deiner Erklärungen erstaunt. Es fällt mir glaube ich schwerer das Problem zu beschreiben als dir die Lösung. Wirklich klasse. Und das noch am heiligen Sonntag.
Wirklich herzlichen Dank!!!

Beste Grüße
Nico