Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1976to1980
1976to1980
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bild einfügen mit VBA

Forumthread: Bild einfügen mit VBA

Bild einfügen mit VBA
22.05.2024 10:28:34
Stefan
Hallo zusammen,

ich hatte diese Frage schon einmal offen, aber leider keine funktionierende Lösung erhalten.
Ist es über VBA möglich folgendes zu steuern (siehe Beispieldatei)?

Reiter Tabelle2: Wenn ich bei C4, C5... ein x eintrage, soll dort automatisch anstatt das X, das Bild aus dem Reiter VORLAGE (B2) übernommen werden.

https://www.herber.de/bbs/user/169635.xlsx

Vielen Dank schon mal im Voraus

Beste Grüße
Stefan
Anzeige

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild einfügen mit VBA
22.05.2024 11:29:04
UweD
Hallo

so?

- Rechtsclick auf den Tabellenblattreiter von Tabelle2
- Code anzeigen
- rechts diesen Code eintragen 

Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    

    Dim Zeile As Integer, TBv As Worksheet, Z1 As Integer, RNG As Range

    

    Set TBv = Sheets("VORLAGE")

    Z1 = 3 'Überschrift

    Set RNG = Range("C:D")

    

    If Not Intersect(Target, RNG) Is Nothing Then

        If Target.Row > Z1 Then

            If Target = "x" Then

                Zeile = WorksheetFunction.CountIf(TBv.Columns(1), Cells(Z1, Target.Column))

                If Zeile > 0 Then

                    Zeile = WorksheetFunction.Match(Cells(Z1, Target.Column), TBv.Columns(1), 0)

                    Application.EnableEvents = False

                    TBv.Cells(Zeile, 2).Copy Target

                    

                End If

            End If

        End If

    End If

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub


Der Code überwacht Änderungen in Spalte C und D ab Zeile 4
und kopiert dann die Zelle (in der sich dann auch die Grafik befinden soll)

LG UweD
Anzeige
AW: Bild einfügen mit VBA
22.05.2024 12:10:51
Alwin Weisangler
Hallo Stefan,
Wenn das Problem mit dem X in der Zielzelle nicht wäre, könntest du dies per Formel (Office 365) machen.
Da du aber in die Zelle wo das x gesetzt wird das Bild darüber haben willst, wäre dies nur mit etwas VBA zu erschlagen.

Ins Modul des Tabellenblattes "Tabelle2": 


Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Bild As Shape: Set Bild = Tabelle1.Shapes("Picture 4")

    If Not Intersect(Target, Range("C4:C" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then

        Application.EnableEvents = False

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

        Application.EnableEvents = True

    End If

End Sub


Gruß Uwe
Anzeige
AW: Bild einfügen mit VBA
23.05.2024 07:58:52
Stefan
Hallo Uwe,

vielen Dank, das funktioniert genau so wie ich es wollte.
Für meine Tabelle habe ich es wie folgt angepasst.... 

Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Bild As Shape: Set Bild = Tabelle3.Shapes("Grafik 14")

    If Not Intersect(Target, Range("C6:C122" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then

        Application.EnableEvents = False

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

        Application.EnableEvents = True

    End If

End Sub


Jetzt würde ich gerne mit einer anderen Grafik in D6:D122 weiter machen. 
Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Bild As Shape: Set Bild = Tabelle3.Shapes("Grafik 16")

    If Not Intersect(Target, Range("D6:D122" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then

        Application.EnableEvents = False

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

        Application.EnableEvents = True

    End If

End Sub


wie kann ich diese beiden codes verbinden?

Vielen Dank,
Gruß
Stefan
Anzeige
AW: Bild einfügen mit VBA
23.05.2024 09:35:16
UweD
Hallo

Ich bin zwar der andere Uwe, aber helfe dir auch bei diesem Code gerne weiter.

Tipp vorweg:
Wenn du mit dem Ausschalten von Events arbeitest, solltest du immer eine Fehlerbehandlung mit einbauen, sonst bleiben Diese im Fehlerfall ausgeschaltet und werden nicht weiter ausgeführt.

So? 
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Dim Bild As Shape, LR As Long

    LR = Cells(Rows.Count, 2).End(xlUp).Row

    If Not Intersect(Target, Range("C6:C" & LR)) Is Nothing Then

        Set Bild = Tabelle3.Shapes("Grafik 14")

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            Application.EnableEvents = False

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

    End If

        

    If Not Intersect(Target, Range("D6:D" & LR)) Is Nothing Then

        Set Bild = Tabelle3.Shapes("Grafik 16")

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            Application.EnableEvents = False

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

    End If

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub


Das Festlegen der letzten Zeile habe ich (meiner Meinung nach) berichtigt

LG UweD
Anzeige
AW: verkürzt..
23.05.2024 09:41:32
UweD 
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Dim Bild As Shape, LR As Long

    LR = Cells(Rows.Count, 2).End(xlUp).Row

    

    If Not Intersect(Target, Range("C6:C" & LR, "D6:D" & LR)) Is Nothing Then

        Select Case Target.Column

            Case 3

                Set Bild = Tabelle3.Shapes("Grafik 14")

            Case 4

                Set Bild = Tabelle3.Shapes("Grafik 16")

        End Select

        

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            Application.EnableEvents = False

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

    End If

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear


LG UweD
Anzeige
AW: verkürzt..
23.05.2024 16:02:42
Stefan
Hallo,

das funktioniert leider gar nicht.
Ich bekomme nicht mal eine Fehlermeldung.

Gruß
Stefan
AW: verkürzt..
23.05.2024 16:54:17
UweD
Hi

Dann lade mal deine Datei hoch, so wie sie aktuell aufgebaut ist.

AW: verkürzt..
23.05.2024 17:06:17
schauan
Hallöchen,

mach auch mal das:

1)
beende Excel und starte alles neu oder nimm ein kleines Makro 
Sub EneMeneElevents()

Application.EnableEvents = True

End Sub

klappt es dann?

2)
Setze einen Haltepunkt in diese Zeile
LR = Cells(Rows.Count, 2).End(xlUp).Row
Kommst Du bzw. das Makro dahin?
Welchen Wert hat LR?
Wie geht es weiter?
Anzeige
AW: verkürzt..
24.05.2024 06:39:17
Stefan
Super, jetzt funktioniert es :)

Vielen Dank euch allen!

Gruß
Stefan
AW: verkürzt..
24.05.2024 09:21:12
UweD
Hallo

Wenn es die Ursache wie unter 1) beschrieben war, dann trifft genau das zu, was ich dir geraten hatte,

...Eine Fehlerbehandlung einzubauen, sobald du "Application.EnableEvents = False" verwendest.

In einem Fehlerfall, oder bei Abbruch wird Das nicht mehr zurückgesetzt und bis zum nächsten Excelstart reagiert die Datei nicht mehr auf Ereignisse.


LG UweD
Anzeige
;

Forumthreads zu verwandten Themen

Leseschutz für Datei, mit VBA aufheben
Iro

Hallo,
folgendes Problem: ich will zwischen zwei Dateien Daten austauschen. Die A-datei soll grundsätzlich PW-geschützt werden, und zwar so, dass der User weder etwas verändern kann noch sie überhaupt öffnen. Nur wenn der User aus der B-datei mit der vorgesehenen Form Daten überträgt, soll...
21.10.2008 14:18:57
Thread-ID: 1017997
4 Beiträge
Anzeige
flexible txt-Datei öffnen mit VBA
Mike

Hey Cracks,
mittels nachfolgendem Code importiere ich .txt-Dateien ins Excel.
Da es nicht immer die gleiche txt-Datei ist, würde ich gerne die
Auswahl "flexibel" halten. Wie mach ich das?
Sub Txt1_KST_importieren() ' öffnet die exportierten Kostenstellen - Txt1_importieren Mak...
05.02.2009 15:36:31
Thread-ID: 1047405
3 Beiträge
Anzeige
Sheet kopieren, einfügen und umbenennen
Mandy

Hi,
ich muss doch noch mal was fragen:
Ich möchte in meiner Datei von einem sheet einen Kopie machen , neu einfügen und mit Namen benennen. das mach ich so:
Sheets("Temp").Copy after:=Sheets("Temp")
ActiveSheet.Name = "Ablage"
Dazu nun zwei Fragen:
1. Das neue Sheet "Abl...
26.03.2009 22:31:22
Thread-ID: 1064423
5 Beiträge
Blatt in selber Mappe kopieren und umbenennen
SteffenS

Hallo Zusammen,
ich habe ein Blatt M1 und möchte dieses per Makro gern in der gleichen Mappe noch 11x kopieren und gleichzeitig umbennenn (M2.....M12).
Wie stelle ich dies am Besten an?
Danke im Voraus.
MFG
Steffen Schmerler
14.04.2009 22:30:25
Thread-ID: 1068755
3 Beiträge
Anzeige
Ordner kopieren und umbenennen
Benedikt

Guten Abend zusammen
Den ganzen Tag suchte ich Lösungen im Netz, aber ich komme nicht klar
Textbox1 enthält z.b: 9516 Meier. Jetzt möchte ich von Laufwerk O: Vorlagen den ganzen Ordner Test nach O: Aktuelle kopieren und Ihm den Namen 9516 Meier geben.
Kann die bereits darin enthalte...
26.04.2009 21:50:41
Thread-ID: 1071246
3 Beiträge
Makro: Datei (feste Werte) kopieren und versenden
Niko

Hallo zusammen,
bin absoluter VBA-Neuling habe jedocg per google unten stehendes Makro gefunden.
Es hilft mir jedoch nur zum Teil. Ich möchte eine Arbeismappe (welche mehrere Sheets enthält) und mit vielen Verknüpfungen befüllt ist als Versanddatei ohne diese Verknüpfungen erstellen un...
03.06.2009 12:27:02
Thread-ID: 1078831
3 Beiträge
.DAT-Datei speichern mit VBA unter xls
Peter

Hallo Excel-VBA-Spezialisten,
ich habe eine Datei (xxxx.dat) die nach Bearbeitung durch ein Makro letztendlich als xxxx.xls (xxxx bleibt) gespeichert werden soll. Es wird zwar eine xls-Datei gespeichert, aber in der Datei sind immer noch die Texttrennzeichen enthalten. Wie muss ich nachfolg...
18.06.2009 12:47:46
Thread-ID: 1082544
5 Beiträge
Dateien Zählen mit VBA 2003 Mac
Jan

Hallo!
Wie erstellt mann einen Macro die die Anzahl an Dateien in einen Verzeichnis ermittelt. Dazu habe ich verschieden Beispiele gefunden die mit "FileSearch" arbeiten. Leider verwende ich Excel 2003 für Apple, wo dieser Funktion nicht vorhanden ist. Vielleicht kennt jemand einen Workarou...
23.06.2009 16:02:28
Thread-ID: 1083851
3 Beiträge
VBA beim anlegen neuer Datei mit kopieren
Stefanglander

Mal wieder ich,
Hallo Leute
ich habe ein Code von Hajo in meiner Datei eingebaut.
Es geht um den Kalender der sich beim betreten der Zelle einblendet ( ein super Teil, kann ich nur empfehlen).
Nun lege ich mittels folgendem Code eine neue Mappe an:
Sub Tab2() Dim strFile As...
16.08.2009 19:31:38
Thread-ID: 1096268
4 Beiträge
Anzeige
Blatt per VBA mit FreePDF als PDF-Datei sichern
Mike

Hallo,
wer kann mir einen Weg oder Beispiel zeigen, wie ich per VBA mit FreePDF ein Worksheet als PDF-Datei speichern kann?
Vielen Dank, Mike.
02.10.2009 00:05:48
Thread-ID: 1106727
5 Beiträge
VBA-Projekt innerhalb Datei kopieren
Gregor

Hallo Excel-Profis
Folgendes Problem, dass ich trotz intensiver Recherche nicht gelöst bekomme:
Möchte das VBA-Projekt der Arbeitsmappe("2") mit dem VBA-Projekt der Arbeitsmappe("1") überschreiben.
(beide Blätter sind in einer Datei).
Kann mir jemand helfen?
Vielen Dank!
...
03.12.2009 13:09:19
Thread-ID: 1121578
7 Beiträge
TXT - Dateien aus Verz. kopieren und zus.fassen
brend

Hallo Freaks,
ich habe x - viele Dateien im txt - Format (Text tabstopp-getrennt) in einem Verzeichnis liegen. Alle Dateien weisen den gleichen Aufbau auf (Format, Zeilen, Spalten). Der einzige Unterschied ist der Zellinhalt (Wert) und der Dateiname.
konkretes Beispiel:
https://www....
27.01.2010 19:15:49
Thread-ID: 1133479
4 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige