Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Mausklick auf Zeile + Userform + Autom. Werte aus Zeile ziehen

Thema geschlossen 
Baumstrukturmodus
Mausklick auf Zeile + Userform + Autom. Werte aus Zeile ziehen
Bastrong Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 31.08.2017
Version(en): 2013
#11
06.09.2017, 13:35
Hallo Uwe,

erst einmal möchte ich mich für deine Bemühungen bedanken.
Ich habe mich ein wenig an der Liste versucht.

Leider komme ich nicht weiter.

Folgendes Problem:

Zitat:Private Sub UserForm_Initialize() 'Comboboxen Belegung"

Dim Typ As Integer
'Schleife zum Füllen der ComboBox mit den Daten aus Blatt "Vorlage"
'Spalte A ab Zeile 3 bis zur letzten gefüllten Zeile
For Typ = 3 To Sheets("Vorlage").Range("A65536").End(xlUp).Row
ComboBox1.AddItem Sheets("Vorlage").Cells(Typ, 1)
Next

For Typ = 3 To Sheets("Vorlage").Range("H65536").End(xlUp).Row  'Angebotsverfolgung "Typ-Auswahl"             'ComboBox für "Angebotsverfolgungstyp"
ComboBox8.AddItem Sheets("Vorlage").Cells(Typ, 8)
Next

End Sub
Damit belege ich alle ComboBox1-8. Die Übertragung in die jeweilige Zelle funktioniert auch. Wenn ich jedoch UF mit Doppelklick aufrufe, dann sind die Comboboxen leer und die Zellen sind gelöscht.
Kannst du mir den Code durchgeben, dass das Problem verhindert?
Des Weiteren habe ich mich an der Checkbox9 versucht.
Zitat: '------ "Angebot verfolgt - Checkbox9" / Beginn -------
  With Cells(Me.Tag, 20)
    'nur wenn momentaner Wert von ursprünglichem Wert abweicht
   If CBool(CheckBox9.Value) <> CheckBox9.Tag Then
      If CheckBox9.Value = True Then
        .Interior.ColorIndex = 10
        .Borders.LineStyle = xlContinuous
      Else
        .Borders.LineStyle = xlNone
        .Interior.ColorIndex = xlNone
      End If
    End If
   End With
  '------ "Angebot verfolgt - Checkbox9" / Ende -------
erst dann sollte die Kommentar-Funktion, die du bereits eingebettet hast funktionieren.
Vielleicht kannst du mir dazu auch was sagen.
Es ist mir schon ein wenig peinlich dich mit solchen Lappalien zu belästigen.

Besten Dank im Voraus.
Freundlicher Gruß


Angehängte Dateien
.xls   Versuch 1-6.xls (Größe: 111 KB / Downloads: 2)
Suchen
Antworten Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#12
07.09.2017, 09:41
Hallo Bastrong,

hier der komplette UF-Code:

Dialog UserForm1
Option Explicit 



Private Sub CommandButton2_Click()  'Button "Schließen ohne Änderungen" 

 Unload Me 

End Sub 



Private Sub CommandButton4_Click()  'Button "Übernehmen und Schließen" 

 Dim i As Long, j As Long 

 Cells(Me.Tag, 2).Value = TextBox2.Text     'Infor 

 Cells(Me.Tag, 3).Value = TextBox3.Text     'Kunde 

 Cells(Me.Tag, 4).Value = TextBox4.Text     'Ort 

 Cells(Me.Tag, 5).Value = TextBox5.Text     'Vertretung 

 Cells(Me.Tag, 6).Value = TextBox6.Text     'Datum 

 Cells(Me.Tag, 7).Value = TextBox7.Text     'Anfrage-Datum 

 Cells(Me.Tag, 32).Value = TextBox8.Text    'Angebotswert 

 Cells(Me.Tag, 34).Value = TextBox10.Text   'Bemerkung 

 Cells(Me.Tag, 10).Value = TextBox11.Text   'ID 

 If TextBox11.Value = True Then             'Wenn Textbox Wert bekommt, dann "O" + Range wird farblich markiert 

   Range("J6:L6").Interior.ColorIndex = 38 

   Cells(6, 12).Value = "O" 

   Else 

   Range("J6:L6").Interior.ColorIndex = xlNone 

   Cells(6, 12).Value = "" 

   End If 

 Cells(Me.Tag, 13).Value = TextBox12.Text   'ID 

 Cells(Me.Tag, 16).Value = TextBox13.Text   'ID 

 Cells(Me.Tag, 19).Value = TextBox14.Text   'ID 

 Cells(Me.Tag, 22).Value = TextBox15.Text   'ID 

 Cells(Me.Tag, 25).Value = TextBox16.Text   'ID 

 Cells(Me.Tag, 28).Value = TextBox17.Text   'ID 

 Cells(Me.Tag, 33).Value = TextBox18.Text   'Bestellwert 

  

 Cells(Me.Tag, 11).Value = ComboBox1.Text   'Typ 

 Cells(Me.Tag, 14).Value = ComboBox2.Text   'Typ 

 Cells(Me.Tag, 17).Value = ComboBox3.Text   'Typ 

 Cells(Me.Tag, 20).Value = ComboBox4.Text   'Typ 

 Cells(Me.Tag, 23).Value = ComboBox5.Text   'Typ 

 Cells(Me.Tag, 26).Value = ComboBox6.Text   'Typ 

 Cells(Me.Tag, 29).Value = ComboBox7.Text   'Typ 

 Cells(Me.Tag, 9).Value = ComboBox8.Text   'Typ 

  

 '------ "Kunde hat Bestellt - Checkbox1" / Beginn ------- 

 With Cells(Me.Tag, 1).Resize(1, 35) 

   'nur wenn momentaner Wert von ursprünglichem Wert abweicht 

   If CBool(CheckBox1.Value) <> CheckBox1.Tag Then 

     If CheckBox1.Value = True Then 

       .Borders.LineStyle = xlContinuous 

        Range("A6:I6").Interior.ColorIndex = 35 

        Range("Ae6:Ai6").Interior.ColorIndex = 35 

       .Cells(1, 9).Value = "X" 

     Else 

       .Borders.LineStyle = xlNone 

       .Interior.ColorIndex = xlNone 

       .Cells(1, 9).Value = "" 

     End If 

   End If 

 End With 

 '------ "Kunde hat Bestellt - Checkbox1" / Ende ------- 

  

  

 '------ "Angebot verfolgt - Checkbox9" / Beginn ------- 

 With Cells(Me.Tag, 20) 

   'nur wenn momentaner Wert von ursprünglichem Wert abweicht 

   If CBool(CheckBox9.Value) <> CheckBox9.Tag Then 

     If CheckBox9.Value = True Then 

       .Interior.ColorIndex = 10 

       .Borders.LineStyle = xlContinuous 

       If Len(TextBox20.Text) Then 

         If Len(LabelKommentar) Then 

           Cells(Me.Tag, 9).Comment.Text LabelKommentar & vbNewLine & _

                 Format(Date, "dd-mmm-yyyy") & vbNewLine & TextBox20.Text 

         Else 

           Cells(Me.Tag, 9).Comment.Text Format(Date, "dd-mmm-yyyy") & vbNewLine & TextBox20.Text 

         End If 

       End If 

     Else 

       .Borders.LineStyle = xlNone 

       .Interior.ColorIndex = xlNone 

     End If 

   End If 

 End With 

 '------ "Angebot verfolgt - Checkbox9" / Ende ------- 

  

  

j = 1 

 For i = 10 To 28 Step 3 

   j = j + 1             'Schleife für CheckBoxen 2 - 8 

   With Cells(Me.Tag, i).Resize(1, 3) 

     'nur wenn momentaner Wert von ursprünglichem Wert abweicht 

     If CBool(Me.Controls("CheckBox" & j).Value) <> Me.Controls("CheckBox" & j).Tag Then 

       .Borders.LineStyle = xlContinuous 

       If Me.Controls("CheckBox" & j).Value = True Then 

         .Interior.ColorIndex = 35 

         .Cells(1, .Cells.Count).Value = "B" 

       Else 

         .Interior.ColorIndex = 38 

         .Cells(1, .Cells.Count).Value = "O" 

       End If 

     End If 

   End With 

 Next i 

 Unload Me 

End Sub 



Private Sub UserForm_Activate() 

 Dim i As Long 

 Dim oComment As Comment 

 Dim varTyp As Variant 

 Me.Tag = ActiveCell.Row 'Zeilennummer der aktiven Zelle wird gespeichert 

 TextBox1.Enabled = False 'Textbox1 ist schreibgeschützt 

 TextBox1.Text = Cells(Me.Tag, 1).Value    'Angebots-Nr. 

 TextBox2.Text = Cells(Me.Tag, 2).Value    'Infor 

 TextBox3.Text = Cells(Me.Tag, 3).Value    'Kunde 

 TextBox4.Text = Cells(Me.Tag, 4).Value    'Ort 

 TextBox5.Text = Cells(Me.Tag, 5).Value    'Vertretung 

 TextBox6.Text = Cells(Me.Tag, 6).Value    'Datum 

 TextBox7.Text = Cells(Me.Tag, 7).Value    'Anfrage-Datum 

 TextBox8.Text = Cells(Me.Tag, 32).Value    'Angebotswert 

 TextBox10.Text = Cells(Me.Tag, 34).Value   'Bemerkung 

 TextBox11.Text = Cells(Me.Tag, 10).Value   'ID 

 TextBox12.Text = Cells(Me.Tag, 13).Value   'ID 

 TextBox13.Text = Cells(Me.Tag, 16).Value   'ID 

 TextBox14.Text = Cells(Me.Tag, 19).Value   'ID 

 TextBox15.Text = Cells(Me.Tag, 22).Value   'ID 

 TextBox16.Text = Cells(Me.Tag, 25).Value   'ID 

 TextBox17.Text = Cells(Me.Tag, 28).Value   'ID 

 TextBox18.Text = Cells(Me.Tag, 33).Value   'Bestellwert 

  

  

 '###### Kommentar - Anfang ###### 

 With Cells(Me.Tag, 9) 

   If Not .Comment Is Nothing Then 

     Set oComment = .Comment 

   Else 

     Set oComment = .AddComment 

     oComment.Shape.OLEFormat.Object.AutoSize = True 

   End If 

 End With 

 LabelKommentar.Caption = oComment.Text 

 '##### Kommentar - Ende ##### 

  

 CheckBox1 = Cells(Me.Tag, 9).Value = "X" 

 CheckBox2 = Cells(Me.Tag, 12).Value = "B" 

 CheckBox3 = Cells(Me.Tag, 15).Value = "B" 

 CheckBox4 = Cells(Me.Tag, 18).Value = "B" 

 CheckBox5 = Cells(Me.Tag, 21).Value = "B" 

 CheckBox6 = Cells(Me.Tag, 24).Value = "B" 

 CheckBox7 = Cells(Me.Tag, 27).Value = "B" 

 CheckBox8 = Cells(Me.Tag, 30).Value = "B" 

'  CheckBox9 = Cells(Me.Tag, ??).Value = "?"  '<<< hier ergänzen! 

  

 'Momentane CheckBoxwerte werden im jeweiligen Tag der Checkboxen gespeichert 

 For i = 1 To 9 

   Me.Controls("CheckBox" & i).Tag = CBool(Me.Controls("CheckBox" & i).Value) 

 Next i 

  

 'Comboboxen füllen und einstellen 

 With Sheets("Vorlage") 

   varTyp = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value 

   ComboBox8.List = .Range(.Cells(3, 8), .Cells(.Rows.Count, 8).End(xlUp)).Value 

   ComboBox8.Value = Cells(Me.Tag, 8).Value 

 End With 

 For i = 1 To 7 

   Me.Controls("ComboBox" & i).List = varTyp 

   Me.Controls("ComboBox" & i).Value = Cells(Me.Tag, (i + 2.7) * 3).Value 

 Next i 

  

End Sub 



VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Beachte den Kommentar zur CheckBox9 im Code.

Gruß Uwe


Angehängte Dateien
.xls   Mausklick auf Zeile + Userform + Autom. Werte aus Zeile ziehen_Kuwer_03.xls (Größe: 82,5 KB / Downloads: 3)
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste