3 Zellen auslesen und weiterverarbeiten

  • Excel

Es gibt 33 Antworten in diesem Thema. Der letzte Beitrag () ist von Andyvankenandy.

    Option Explicit

    Dim dicKey, dicObj As Object

    Private Sub ComboBox1_Change()
    Call SetPicturePath
    End Sub

    Private Sub ComboBox2_Change()
    Call SetPicturePath
    End Sub

    Private Sub ComboBox3_Change()
    Call SetPicturePath
    End Sub

    Sub SetPicturePath()
    Dim aktAuswahlKey As String
    aktAuswahlKey = ComboBox1.Text & ComboBox2.Text & ComboBox3.Text
    Dim i As Integer
    For i = 0 To dicObj.Count - 1
    If aktAuswahlKey = dicKey(i) Then
    Label1.Picture = LoadPicture(dicObj.Item(dicKey(i)))
    Label1.Caption = ""
    Exit Sub
    End If
    Next i
    Label1.Picture = Nothing 'nix passendes gefunden
    Label1.Caption = "Kein passendes Produkt"

    End Sub

    Private Sub UserForm_Initialize()
    Set dicObj = CreateObject("Scripting.Dictionary")
    dicObj.Add "245400050", "Grafik 1" '8DN9-2
    dicObj.Add "300400063", "Grafik 2" '8DN9-6
    dicObj.Add "420400063", "Grafik 2" '8DQ1-6
    dicObj.Add "420500063", "Grafik 3" '8DQ1-1
    dicObj.Add "550500063", "Grafik 3" '8DQ1-1
    dicObj.Add "420500080", "Grafik 4" '8DQ1-8
    dicObj.Add "420630080", "Grafik 4" '8DQ1-8
    dicKey = dicObj.keys
    With ComboBox1
    .AddItem "245"
    .AddItem "300"
    .AddItem "420"
    .AddItem "550"
    End With
    With ComboBox2
    .AddItem "4000"
    .AddItem "5000"
    .AddItem "6300"
    End With
    With ComboBox3
    .AddItem "50"
    .AddItem "63"
    .AddItem "80"
    End With
    End Sub



    So hab ich das Makro jetzt drin. Vielleicht kann sich jemand noch mal erbarmen und schauen was genau ich da in die Schleife reinschreiben muss, damit die Grafiken so auftauen wie in meinem ersten Beitrag? Ja, mir muss man alles vorbeten, ich weiß. Hoffe ihr habt trotzdem Spaß mir zu helfen. Ich muss jetzt erst mal nach Hause und Brechen. 8o

    Ich hab da eine Grafik aus einem Officeprogramm. Wenn ich das einpflege in Exel ist es ja nix anderes als würde ich das in Exel selber gezeichnet haben, oder? Wo kann ich den sehen was das für ein Shape ist?

    Label1.Picture = Images(aktAuswahlKey)

    @petaod: Was müsste ich hier anstelle des Images schreiben, wenn ich das so mache wie in deinem lezten Beitrag(28)

    Danke vielmals das ihr mich unterstützt!

    @flofuchs Dein Makro hat mir auch schon einiges an Verständnis gebracht...

    Die Frage is was und wie du das Lösen willst.
    Wie Du selbst schon erkannt hast. Wenn Du Shapes nehmen willst musst du die auch alle dann von Hand ins Excel eintragen.
    Da finde ich den Weg über einen Ordner mit Bildern doch schon etwas einfacher.

    Die Bilder sind aus MS-Visio. Daher erkennt Exel die immer noch als Shapes. Ich hab sie jetzt auf einem anderen Blatt, musste sie halt alle händisch benamsen. Da das Tool frei verfügbar sein soll, muss das schon alles beinhalten. Jetzt frag ich sie über das passende Worksheet ab. Ich hab Hilfe von einer Kollegin bekommen. Wenn ich das soweit habe stell ich das Makro hier rein.

    Visual Basic-Quellcode

    1. Private Sub ComboBox1_Change()
    2. SetPicturePath
    3. End Sub
    4. Private Sub ComboBox2_Change()
    5. SetPicturePath
    6. End Sub
    7. Private Sub ComboBox3_Change()
    8. SetPicturePath
    9. End Sub
    11. Private Function SetPicturePath() As Boolean
    12. Dim Images As New Collection
    14. InitializeImages Images
    16. For Each mShape In ActiveSheet.Shapes
    17. If Left$(mShape.Name, 6) = "Grafik" Then
    18. mShape.Delete
    19. End If
    20. Next mShape
    22. mName = ""
    23. On Error Resume Next
    24. mName = Images(ComboBox1.Text & ComboBox2.Text & ComboBox3.Text)
    26. If Not mName = "" Then
    27. If Not Worksheets("Grafiken").Shapes(mName) Is Nothing Then
    28. Worksheets("Grafiken").Shapes(mName).Copy
    29. Range("E16").Select
    30. ActiveSheet.Paste
    31. SetPicturePath = True
    32. Else
    33. SetPicturePath = False
    34. End If
    35. Else
    36. SetPicturePath = False
    37. End If
    38. End Function
    40. Private Function InitializeImages(Images As Collection)
    41. With Images
    42. .Add "Grafik 1", "245400050"
    43. .Add "Grafik 2", "300400063"
    44. .Add "Grafik 2", "420400063"
    45. .Add "Grafik 3", "420500063"
    46. .Add "Grafik 3", "550500063"
    47. .Add "Grafik 4", "420500080"
    48. .Add "Grafik 4", "420630080"
    49. End With
    52. End Function



    So funzt das. Freu mich wie Schneekönig. Was eine Geburt. Was sagt ihr zu dem Makro, kann man das noch optimieren?

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Andyvankenandy“ ()

    mach da mal bitte VB-Tags drum herum, dass dat auch mal ein mensch lesen kann..
    I-wie is das nu ein ganz schöner durcheinander...
    wozu hast du die setpicturepath as Boolean? Den brauchste doch für nix?
    i-wie hat das mit dem ganzen am anfang nur noch entfernt ähnlichkeit...?
    Ich muss ehrlich sagen so ganz blick ich da nu nimma durch... :sleeping:
    aber ich glaub das kannst so kürzen:

    Visual Basic-Quellcode

    1. If Not mName = "" And Not Worksheets("Grafiken").Shapes(mName) Is Nothing Then
    2. Worksheets("Grafiken").Shapes(mName).Copy
    3. Range("E16").Paste
    4. SetPicturePath = True
    5. Else
    6. SetPicturePath = False
    7. End If

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „FloFuchs“ ()

    Ich check das auch nicht mehr ganz. Ich weiß was passiert, aber das war es auch schon....Das Boolean kann man wohl noch raus nehmen.

    Aber zumindestens haben wir für die Aufgabe am Anfang, jetzt eine Lösung. Danke euch vielmals!!!