Thema Datum  Von Nutzer Rating
Antwort
Rot If Anweisungen Verschachteln
 07.02.2022 13:18:23 Maegge
NotSolved
07.02.2022 18:26:39 ralf_b
NotSolved
08.02.2022 08:48:50 Gast17706
NotSolved
08.02.2022 17:20:33 ralf_b
*****
Solved
08.02.2022 18:34:34 maegge
NotSolved

Ansicht des Beitrags:
Von:
Maegge		 Datum:
07.02.2022 13:18:23		 Views:
442		 Rating:
     
Antwort:
  Ja
Thema:
If Anweisungen Verschachteln

Hallo zusammen

Folgender Code habe ich aus dem Internet und der Funktioniert auch wie er sollte.......

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("H8:H1000")) Is Nothing Then
        With ActiveSheet.OLEObjects("Firma")
            .LinkedCell = Target.Address  ' Zellverknüpfung ist die Zieladresse
            .Top = Target.Top             ' Position oben
            .Left = Target.Left           ' Position links
            .Width = Target.Width         ' Breite
            .Height = Target.Height * 2   ' Höhe
            .Object.MatchRequired = True    ' nur vorhandene Einträge
            .Object.ListRows = 20           ' Zeilenanzahl der Liste
            .Object.Font.Size = 10          ' Schriftgröße
            .Visible = True
            .Object.DropDown                ' DropDown öffnen
            .Activate                       ' aktivieren
        End With
   ElseIf Not Intersect(Target, Range("N8:N1000")) Is Nothing Then
        With ActiveSheet.OLEObjects("Kontakt")
            .LinkedCell = Target.Address  ' Zellverknüpfung ist die Zieladresse
            .Top = Target.Top             ' Position oben
            .Left = Target.Left           ' Position links
            .Width = Target.Width         ' Breite
            .Height = Target.Height * 2   ' Höhe
            .Object.MatchRequired = True    ' nur vorhandene Einträge
            .Object.ListRows = 20           ' Zeilenanzahl der Liste
            .Object.Font.Size = 10          ' Schriftgröße
            .Visible = True
            .Object.DropDown                ' DropDown öffnen
            .Activate                       ' aktivieren
        End With
    ElseIf Not Intersect(Target, Range("G8:G1000")) Is Nothing Then
        With ActiveSheet.OLEObjects("Badge")
            .LinkedCell = Target.Address  ' Zellverknüpfung ist die Zieladresse
            .Top = Target.Top             ' Position oben
            .Left = Target.Left           ' Position links
            .Width = Target.Width         ' Breite
            .Height = Target.Height * 2   ' Höhe
            .Object.MatchRequired = True    ' nur vorhandene Einträge
            .Object.ListRows = 20           ' Zeilenanzahl der Liste
            .Object.Font.Size = 10          ' Schriftgröße
            .Visible = True
            .Object.DropDown                ' DropDown öffnen
            .Activate                       ' aktivieren
        End With
    Else
        ActiveSheet.OLEObjects("Firma").Visible = False
        ActiveSheet.OLEObjects("Kontakt").Visible = False
        ActiveSheet.OLEObjects("Badge").Visible = False
    End If
 
End Sub

 

Nun möchte ich auf dem gleichen Tabellenblatt noch folgenden Code ausführen aber weiss nicht wie ich diesen integriere.


 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
'bearbeiten mehrerer Zeilen wird abgefangen
    If Target.Count > 1 Then Exit Sub
 
    If Intersect(Target, Range("D8:D1000,Q8:P1000")) Is Nothing Then Exit Sub
 
 
    If Target.Value = "Name1" Or Target.Value = "Name2" Or Target.Value = "Name3" Or Target.Value = "Name4" Or Target.Value = "Name5" Or Target.Value = "Name6" Then
     
Target.Offset(0, 1) = Format(Date, "dd.mm.yyyy")
    Target.Offset(0, 2) = Format(Time, "hhmm")
    Else
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
 
    End If
 
    End Sub

 

Merci

 

Gruss Markus

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot If Anweisungen Verschachteln
 07.02.2022 13:18:23 Maegge
NotSolved
07.02.2022 18:26:39 ralf_b
NotSolved
08.02.2022 08:48:50 Gast17706
NotSolved
08.02.2022 17:20:33 ralf_b
*****
Solved
08.02.2022 18:34:34 maegge
NotSolved