Office: spaltenabhängige Bildzuweisung über true-Wert?

Hallo,

ich habe das folgende Problem: Ich übernehme eine Tabelle aus Access in Excel (siehe Anhang) und möchte jeden false-Wert ausgebelendet (das ist nicht das Problem) und anstelle des true-Wertes ein spaltenabhängiges Bild in die jeweilige Zelle einfügen. Ist sowas überhaupt möglich?

Vielen Dank im Voraus!

Beste Grüße
Mad

 

Hi,

mit VBA ist (fast) alles möglich, die Frage ist nur - ist es auch sinnvoll? Ich würde an deiner Stelle lieber die bedingte Formatierung verwenden und den betreffenden Zellen eine Füllfarbe zuweisen, die Spalten-abhängig ja durchaus unterschiedlich sein kann.

Bis später,
Karin

 

Hallo Karin (mal wieder) :lol:

Der Klou an der Geschichte soll ja sein, dass das entsprechende Gefahrensymbol (siehe Spaltenname) in die Zelle, wo "true" steht, eingeblendet wird.
Ich weiß gar nicht, ob sowas mit Excel geht, denn wenn ich ein Bild einfüge erscheint es leider irgendwo auf dem Bildschirm und nicht in der Zelle :-?


Beste Grüße
Mad

 

Hallo!

Aber wenn du über die bedingte Formatierung die entsprechenden Zellen farbig (rot) hinterlegst, ist das doch auch auffällig genug, oder?
Diese Methode ist wesentlich(!) unaufwändiger als zig Bilder mit zig Zellen zu verknüpfen!

 

Hi,

ein Bild kann man positionieren, indem man .Top und .Left mit dem .Top und .Left der betreffenden Zelle übereinstimmend setzt - nach diesem Prinzip:

Code:

    With ActiveSheet.Pictures.Insert("C:\Test\DSC02117.png")
        .Top = Cells(5, 2).Top
        .Left = Cells(5, 2).Left
    End With

Bis später,
Karin

 

Hallo,

Bilder werden nicht mit den Zellen verknüpft sondern auf die Zellen gelegt.

Bis später,
Karin

 

Gibt es vielleicht einen Font wie "Symbol", "WingDings", "WebDings" oder so, in dem diese Symbole enthalten sind? Dann könntest Du mit WENN() über die true/false-Werte wahrscheinlich sehr viel Resourcen-sparender (und ohne VBA) zum Ergebnis kommen, als mit elend vielen Bildern.

Gruß, Michael

 

Hallo und danke für die vielen Antworten!

Melde mich aus dem Wochenendurlaub zurück (Muss auch mal sein *gg*)

@Michael: Idee ist äußerst interessant und hab mich auch mal ein wenig schlau gmacht auf dem Gebiet, aber zum einen nix von Gefahrstoffsymbolen gefunden und zum anderen besteht das Problem, dass die Datenbank, sowie Abfrage auf einem Server im Intranet liegen und jeder darauf zugreifen kann, weshalb erst jeder diesen Schrifttyp installiert haben müsste.

@Karin: Du hast es mal wieder getroffen ;-)
Kannst du mir das noch einmal so programmieren, dass er die Zeilen 1-200 in einer Spalte durchgeht und jede Zeile, wo true steht durch ein Bild ersetzt? Dann bräuchte ich nur für jede Spalte ein Makro anlegen mit dem entsprechenden Pfad zum Bild.

Beste Grüße
Mad

 

Hi Mad,

Code:

Sub BilderEinfuegen()
    Dim lngZeile As Long
    Dim strBild As String
    Dim strSpalte As String
    Dim intSpalte As Integer
    strSpalte = Application.InputBox("Bitte die Spalte angeben", "Spaltenauswahl", "B", Type:=2)
    On Error Resume Next
    intSpalte = Columns(strSpalte).Column
    On Error GoTo 0
    If intSpalte = 0 Then
        MsgBox "Diese Spaltenbezeichnung gibt es nicht"
    Else
        Application.ScreenUpdating = False
        Select Case strSpalte
            Case "B"
                strBild = "C:\Test\DSC02117.png"
            Case "C"
                strBild = "C:\Test\DSC02118.png"
            Case "D"
                strBild = "C:\Test\DSC02119.png"
        End Select
        For lngZeile = 2 To 200
            On Error Resume Next
            ActiveSheet.Shapes(Cells(lngZeile, intSpalte).Address(False, False)).Delete
            On Error GoTo 0
            If Cells(lngZeile, intSpalte) = True Then
                With ActiveSheet.Pictures.Insert(strBild)
                    .Top = Cells(lngZeile, intSpalte).Top
                    .Left = Cells(lngZeile, intSpalte).Left
                    .Height = Cells(lngZeile, intSpalte).Height
                    .Width = Cells(lngZeile, intSpalte).Width
                    .Name = Cells(lngZeile, intSpalte).Address(False, False)
                End With
            End If
            Application.ScreenUpdating = True
        Next lngZeile
    End If
End Sub

Die Bildbezeichnung/Pfad und Anzahl der Case musst du natürlich an deine Bedingungen anpassen.

Du musst aber damit leben, dass der Code einige Zeit braucht um durchzulaufen, auch das Bildschirmflackern lässt sich nicht vermeiden.

Bis später,
Karin

 

Hallo Karin,

erst einmal vielen lieben Dank für den Code, obwohl es gar nicht so kompliziert hätte sein müssen:
Ich bräuchte "nur" die Funktion, das jedem TRUE-Wert in Spalte B ein bestimmtes Bild zugewiesen wird und jedem TRUE-Wert in Spalte C ein anderes etc... Und das ganze bis J, da es 9 Gefahrenstoffsymbole gibt.
Wäre gut, wenn er das in einem Rutsch machen würde und es spielt auch keine Rolle, wie lange er braucht und wie stark es flackert.
Ich hab gerade verzweifelt versucht das aus deinem Code umzuschreiben, aber er haute mir nur Fehlermeldungen raus, was mich schnell zurück auf den Boden der Tatsachen, bezüglich meines Könnens, geholt hat
Aber den Abfrage Teil hab ich mir trotzdem mal schön rauskopiert und bin mir ganz sicher, dass der demnächst auch Verwendung finden wird :-)


Beste Grüße
Mad

 

Hi Mad,

Code:

Sub BilderEinfuegen2()
    Dim lngZeile As Long
    Dim strBild As String
    Dim intSpalte As Integer
    Application.ScreenUpdating = False
    For intSpalte = 2 To 10
        Select Case intSpalte
            Case 2
                strBild = "C:\Test\DSC02117.png"
            Case 3
                strBild = "C:\Test\DSC02118.png"
            Case 4
                strBild = "C:\Test\DSC02119.png"
            Case 5
            Case 6
            Case 7
            Case 8
            Case 9
            Case 10
        End Select
        For lngZeile = 2 To 200
            On Error Resume Next
            ActiveSheet.Shapes(Cells(lngZeile, intSpalte).Address(False, False)).Delete
            On Error GoTo 0
            If Cells(lngZeile, intSpalte) = True Then
                With ActiveSheet.Pictures.Insert(strBild)
                    .Top = Cells(lngZeile, intSpalte).Top
                    .Left = Cells(lngZeile, intSpalte).Left
                    .Height = Cells(lngZeile, intSpalte).Height
                    .Width = Cells(lngZeile, intSpalte).Width
                    .Name = Cells(lngZeile, intSpalte).Address(False, False)
                End With
            End If
        Next lngZeile
    Next intSpalte
    Application.ScreenUpdating = True
End Sub

Übrigens, in dem Code aus meinem vorhergehenden Beitrag ist noch ein Fehler: die Zeile Application.ScreenUpdating = True muss nach Next lngZeile stehen, dann flackert auch nichts mehr (so wie bei dem jetzigen Code). Hatte mich eigentlich schon gewundert, aber wie das manchmal so ist - die Ursache nicht gleich gefunden.

Bis später,
Karin

 

Hallo Karin,

Sehr cool -Genau das, was ich gesucht habe. Vielen, vielen Dank mal wieder :mrgreen:
Ich muss das noch alles einpflegen und ordentlich machen, aber ich glaube, das ich erstmal keine weiteren Fragen mehr habe (was soviel heißt wie: kann sich nur um ein paar Tage handeln *hehe*)


Beste Grüße
Mad