Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
568to572
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
568to572
568to572
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

An Josef Ehrensberger

An Josef Ehrensberger
18.02.2005 22:28:00
Ernst
Hallo Sepp
Habe noch eine Nachfrage bezüglich dem Code von gestern.
Habe Deinen Code um einen Wiederholungsblock ergänzt, es funktioniert auch!
Hätte man den Code nun einfacher schreiben können?
Bitte um eine Antwort.
mfg
Ernst Dunkel
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
On Error Resume Next
Me.Shapes("W17").Delete
Sheets("Tabelle3").Shapes(Target.Text).Copy
Me.Paste
With Me.Shapes(Me.Shapes.Count)
.Name = "W17"
.Left = 100
.Top = 20
End With
Target.Select
End If
If Target.Address = "$A$10" Then
On Error Resume Next
Me.Shapes("curPic").Delete
Sheets("Tabelle3").Shapes(Target.Text).Copy
Me.Paste
With Me.Shapes(Me.Shapes.Count)
.Name = "curPic"
.Left = 100
.Top = 200
End With
Target.Select
End If
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: An Josef Ehrensberger
18.02.2005 22:48:41
Josef
Hallo Ernst!
Das ist schon OK so!
Wenn du noch mehrere solcher Blöcke brauchst, dann ginge das eventuell
auch mit "Select Case", aber das ist dann auch nicht viel kürzer!
Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
AW: An Josef Ehrensberger
Reinhard
Hi Ernst,
wie Josef schon sagte, "kürzer" kommt erst bei vielen Blöcken zum Tragen:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Select Case Target.Address(0, 0)
Case "A10"
Call ttt("W17", 100, 20) ' oder auch Call ttt "W17", 100, 20, ich weiss das nie genau *g
Case "B1"
Call ttt("curPic", 100, 200)
Case "B9"
Call ttt("xyz", 50, 50)
Case "B11"
Call ttt("abc", 0,0)
End Select
End Sub
Sub ttt(Name1 As String, links As Integer, oben As Integer)
Me.Shapes(Name1).Delete
Sheets("Tabelle3").Shapes(Target.Text).Copy
Me.Paste
With Me.Shapes(Me.Shapes.Count)
.Name = Name1
.Left = links
.Top = oben
End With
End Sub

Gruß
Reinhard
Anzeige
AW: An Josef Ehrensberger
18.02.2005 22:58:30
Ernst
Hallo Sepp
Hallo Rainer
Vielen Dank für Deine Antwort Sepp.
Recht Herzlichen Dank Rainer für Deinen Code.
mfg
Ernst Dunkel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige