Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1576to1580
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
Inhaltsverzeichnis

Bild mit Übertragen

Bild mit Übertragen
30.08.2017 22:46:14
Michael
Hallo Leute bräuchte mal eure Hilfe,
und zwar habe ich folgendes vor.
Wenn ich im Tabellenblatt "Fehleranalyse Einzelteile" rechts oben in der Schwarzen Listenauswahl eine nummer auswähle soll Excel mir die Daten aus dem Tabellenblatt "Datenpool" in das Tabellenblatt "Fehleranalyse Einzelteile" übertragen.
Das klappt auch nur das Jeweilige Bild dazu überträgt er nicht.
Bin in VBA nicht so fitt.
Das Makro habe ich aus einer anderen Datei.
Habe die komplette Datei angehängt es ist nur ein bruchteil der Daten kommen noch viele dazu.
Ich hoffe ihr könnt mir weiter helfen.
Danke schonmal für eure mühe.
Lg Michael
https://www.herber.de/bbs/user/115899.xlsm

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vorschlag Picture Link ohne VBA
31.08.2017 09:40:16
Michael
Danke Chris
das schau ich mir mal an.
Lg Michael
AW: Bild mit Übertragen
31.08.2017 09:16:22
Beverly
Hi Michel,
im Anhang eine VBA-freie Lösung mit einem definierten Namen und einem verknüpften Bild.
https://www.herber.de/bbs/user/115904.xlsm
Falls du eine VBA-Lösung bevorzugst, dann deinen Code um den folgenden ergänzen:
    Dim rngSpalte As Range
Dim shaShape As Shape
For Each shaShape In ActiveSheet.Shapes
If shaShape.TopLeftCell.Address = "$E$8" Then
shaShape.Delete
Exit For
End If
Next shaShape
With Worksheets("Datenpool")
Set rngSpalte = .Rows(1).Find(ComboBox1.Value, lookat:=xlWhole)
If Not rngSpalte Is Nothing Then
For Each shaShape In .Shapes
If .Range(shaShape.TopLeftCell.Address).Column = rngSpalte.Column Then
shaShape.Copy
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Top = Range("E8").Top
.Left = Range("E8").Left
End With
Exit For
End If
Next shaShape
End If
End With


Anzeige
AW: Bild mit Übertragen
31.08.2017 09:39:13
Michael
Super Danke Karin
genau so hab ich es mir vorgestellt.
kann ich da jetzt auch mehr Daten eintragen in das Tabellenblatt "Datenpool".
LG Michael
Ist das eine Frage oder Aussage? o.w.T.
31.08.2017 10:39:48
Beverly


AW: Ist das eine Frage oder Aussage? o.w.T.
31.08.2017 10:45:53
Michael
Hallo Karin
Sorry mein Fehler sollte eine Frage sein hab es ausprobiert geht .
Danke viel Mals
Lg Michael
AW: Ist das eine Frage oder Aussage? o.w.T.
01.09.2017 21:09:38
Michael
Hallo Karin
Hätte nochmal eine Frage das mit dem Bild übertragen klappt super nur wäre es auch möglich das er es in die Tabelle 2 "Diagramm" in Zelle C31 auch noch mit überträgt.
Danke
Lg Michael
AW: Ist das eine Frage oder Aussage? o.w.T.
02.09.2017 07:40:56
Michael
Hallo Karin
Hätte nochmal eine Frage das mit dem Bild übertragen klappt super nur wäre es auch möglich das er es in die Tabelle 2 "Diagramm" in Zelle C31 auch noch mit überträgt.
Danke Lg
Michael
Anzeige
Welche Variante? o.w.T.
02.09.2017 08:01:27
Beverly


AW: Welche Variante? o.w.T.
02.09.2017 08:03:10
Michael
Hi
Habe die Makro Variante genommen.
Danke
Michael
VBA-Variante
02.09.2017 08:18:56
Beverly
Hi Michael,
    Dim rngSpalte As Range
Dim shaShape As Shape
For Each shaShape In ActiveSheet.Shapes
If shaShape.TopLeftCell.Address = "$E$8" Then
shaShape.Delete
Exit For
End If
Next shaShape
For Each shaShape In Worksheets("Diagramm").Shapes
If shaShape.Name = "NeuEingefuegt" Then
shaShape.Delete
Exit For
End If
Next shaShape
With Worksheets("Datenpool")
Set rngSpalte = .Rows(1).Find(ComboBox1.Value, lookat:=xlWhole)
If Not rngSpalte Is Nothing Then
For Each shaShape In .Shapes
If .Range(shaShape.TopLeftCell.Address).Column = rngSpalte.Column Then
shaShape.Copy
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Top = Range("E8").Top
.Left = Range("E8").Left
End With
Exit For
End If
Next shaShape
With Worksheets("Diagramm")
.Paste
With .Shapes(.Shapes.Count)
.Name = "NeuEingefuegt"
.Top = .Parent.Range("C31").Top
.Left = .Parent.Range("C31").Left
End With
DoEvents
End With
End If
End With

Ich frage mich dennoch: weshalb muss es immer VBA sein, wenn man es auch anders lösen kann? Dazu müsste man nut das verknüpfte Bild kopieren und in der anderen Tabelle einfügen.


Anzeige
AW: VBA-Variante
02.09.2017 08:22:47
Michael
Danke Karin
Probiere ich dann gleichviel aus.
Da es für die Arbeit ist und viele diese Tabelle nutzen und viele dabei sind wo keine Ahnung von excel haben.
Bevor mir jemand was verschiebt.
Lg Michael
AW: VBA-Variante
02.09.2017 11:13:35
Michael
Super Karin
Genau so sollte es sein.
Danke Lg Michael
AW: VBA-Variante
02.09.2017 21:42:52
Michael
Hallo Karin,
ich weiß ich nerve ein bisschen aber eine Frage hätte ich noch.
Könnt man meinen Code so umändern das man unendliche Spalten nutzen kann.
Private Sub ComboBox1_Change()
Dim lastrow As Integer
lastrow = Worksheets("Datenpool").Cells(Rows.Count, 2).End(xlUp).Row + 1
'MsgBox (ComboBox1.ListIndex)
Select Case ComboBox1.ListIndex
Case 0
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("B3:B" & lastrow).Value
Case 1
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("C3:C" & lastrow).Value
Case 2
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("D3:D" & lastrow).Value
Case 3
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("E3:E" & lastrow).Value
Case 4
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("F3:F" & lastrow).Value
Case 5
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("G3:G" & lastrow).Value
und dann kommt ja dein erstellter Teil.
LG Michael
Anzeige
AW: VBA-Variante
04.09.2017 17:56:43
Michael
Hallo Karin,
ich weiß ich nerve ein bisschen aber eine Frage hätte ich noch.
Könnt man meinen Code so umändern das man unendliche Spalten nutzen kann.
Private Sub ComboBox1_Change()
Dim lastrow As Integer
lastrow = Worksheets("Datenpool").Cells(Rows.Count, 2).End(xlUp).Row + 1
'MsgBox (ComboBox1.ListIndex)
Select Case ComboBox1.ListIndex
Case 0
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("B3:B" & lastrow).Value
Case 1
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("C3:C" & lastrow).Value
Case 2
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("D3:D" & lastrow).Value
Case 3
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("E3:E" & lastrow).Value
Case 4
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("F3:F" & lastrow).Value
Case 5
Worksheets("Datenpool").Range("A3:A" & lastrow).Value = Worksheets("Datenpool").Range("G3:G" & lastrow).Value
und dann kommt ja dein erstellter Teil.
LG Michael
Anzeige
AW: VBA-Variante
04.09.2017 22:30:43
Beverly
Hi Michael,
das kannst du auf folgendem Weg lösen:
Private Sub ComboBox1_Change()
Dim lastrow As Integer
With Worksheets("Datenpool")
lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(3, 1), .Cells(lastrow, 1)).Value = _
.Range(.Cells(3, ComboBox1.ListIndex + 2), _
.Cells(lastrow, ComboBox1.ListIndex + 2)).Value
End With
End Sub


AW: VBA-Variante
05.09.2017 06:42:05
Michael
Guten Morgen Karin ,
Das funktioniert super nur setzt er mir jetzt im Tabellenblatt "Fehleranalyse Einzelteile " die Bilder in Zelle E8 übereinander ohne das alte vorher zu löschen.
Sonst alles perfekt.
Könnte man das noch irgendwie umgehen das er das alte Bild von der alten Zeichnungsnummer löscht bevor er das neue einsetzt von der neuen Zeichnungsnummer.
Vielen lieben Dank schonmal für alles
Lg Michael
Anzeige
AW: VBA-Variante
05.09.2017 08:47:09
Beverly
Hi Michael,
das generelle Problem ist, dass Excel Probleme beim Bildschirmaufbau hat, wenn Grafiken kopiert und positioniert werden sollen. Ergänze die beiden Codezeilen vor Exit For
                If .Range(shaShape.TopLeftCell.Address).Column = rngSpalte.Column Then
shaShape.Copy
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Top = Range("E8").Top
.Left = Range("E8").Left
End With
DoEvents
Range("E8").Select
Exit For
End If


AW: VBA-Variante
05.09.2017 09:41:20
Michael
Super Karin
Jetzt passt alles wie gewünscht.
Danke
Lg Michael
Anzeige
AW: VBA-Variante
05.09.2017 17:37:38
Michael
Super Karin
Jetzt passt alles wie gewünscht.
Danke
Lg Michael

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige