Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Grafik automatisch einfügen [VBA?]

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Grafik automatisch einfügen [VBA?] (30254 mal gelesen)
Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 22. Jun. 2006 11:55    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


grafik.jpg

 
Hallo Zusammen,
ich bin auf der Suche nach einer Lösung für folgendes Problem. Wir erzeugen immer wieder autoatisch Exceltabellen, siehe Anhang. Gibt es eine Möglichkeit per VBA die Grafiken in dem Textrahmen einzufügen?
Wenn das mit dem Textrahmen nicht geht, würde es schon sehr viel Zeit sparen die Grafiken neben der Nummer zu haben.

Der manuelle Ablauf sieht z.Z. so aus, dass ich die Nummer aus dem Feld B5 in eine Adresse auflöse die lautet: i:\pdf\H11\11001280.jpg
Die Adresse i:\pdf ist immer gleich - dann folgt H11 (die ersten Stellen der Nummer) - dann folgt 11001280 (die Nummer ohne Striche.

Die Grafikadresse des zweiten Bildes (Feld B9) wäre demnach:
i:\pdf\B56\56130111.jpg

Ich danke Euch ....

Viele Grüße aus Hessen


Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 28. Jun. 2006 09:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Martin,
hatte Urlaub, hab mich jetzt aber mal dranbegeben. Ist bestimmt nicht das schönste Projekt auf Erden, aber läuft vielleicht.
Also:
Vorraussetzungen: Dateinamen sind immer gleich aufgebaut:  X11-222-333, die Abstände der Einfügepunkte sind immer 4 Zeilen und die Pfade und Bilder sind vorhanden. Ansonsten ist Anpassen angesagt  
in Spalte A füge ich hilfsweise den Ordnernamen ein, "unter" das Bild, also  in C den Bildnamen. Den Bildnamen sieht man unter dem Bild nicht, und die Spalte A ist weiße Schrift auf weißem Grund. Bei Nichtgefallen könnte man am Ende des Makros die Spalten A und C leeren hab ich mal in Kommentarzeichen gesetzt
Desweiteren müssen evtl. die Bilder größenmäßig angepasst werden, auch dafür ein Ansatz in Kommentarzeichen.


Code:
Sub GrafikEinfuegen()
Dim i As Integer
    Columns("A:A").Select
    Selection.Font.ColorIndex = 2
    For i = 5 To 15   Step 4          'Bereich anpassen oder letzten Eintrag suchen lassen
        Cells(i, 1).Select
        ActiveCell.FormulaR1C1 = "=MID(RC[+1],1,3)"
        Cells(i, 3).Select
        ActiveCell.FormulaR1C1 = "=MID(RC[-1],2,2)&MID(RC[-1],5,3)&MID(RC[-1],9,3)"
        Cells(i, 3).Select
        ActiveSheet.Pictures.Insert("I:\PDF\" & Cells(i, 1) & "\" & (Cells(i, 3).Value) & ".jpg").Select
       
           'Selection.ShapeRange.LockAspectRatio = msoTrue
           'Selection.ShapeRange.Height = 32.25
           'Selection.ShapeRange.Width = 39.75
           'Selection.ShapeRange.Rotation = 0#
    Next
    'Columns("A:A").ClearContents
    'Columns("A:A").Select
    'Selection.Font.ColorIndex = 1
End Sub

Kommt zwar spät, aber vielleicht hilft's trotzdem noch.

Gruß,
Nicole

[edit: Kleinigkeiten  ]
------------------
Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

[Diese Nachricht wurde von runkelruebe am 28. Jun. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 28. Jun. 2006 11:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Vielen lieben Dank Nicole!
Wenn Bochum nicht so weit von Hessen wäre, würde ich Dir einen Strauß Blumen bringen - nun, sollst einen bekommen, halt virtuell...

Ich hätte noch drei Fragen an Dich...

1.)
Nach dem Programmablauf kommt ein Laufzeitfehler '1004' - wenn ich auf Debuggen gehe, ist die Zeile:
ActiveSheet.Pictures.Insert("i:\PDF\" & Cells(i, 1) & "\" & (Cells(i, 3).Value) & ".jpg").Select
gelb markiert.

Das liegt wahrscheinlich an meiner Änderung: For i = 5 To 1000  Step 4          'Bereich anpassen oder letzten Eintrag suchen lassen

Ist zwar nicht schön aber ich kann damit leben.

2.)
Ich habe, wie in der Grafik vom ersten Beitrag zu sehen ist, ein Rechteck in den Zellen C4-C7 gleichmäßig verteilt. Ist es möglich die Bilder genau in dieses Rechteck zu placieren? Die Größe vom Rechteck ist immer 2,8 cm

3.)
Falls ein Bild nicht vorhanden ist, muss das Programm weiter laufen. Zur Zeit bricht es ab. Kann man das irgendwie realisieren?

Nochmals vielen lieben Dank 

Gruß Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 28. Jun. 2006 12:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Martin!
Vielen Dank für diesen wunderschönen Blumenstrauß! Hab' ich hier noch nie bekommen 

Klar kann man:
Zu 1 und 3:
Zeile einfügen:

Public Sub GrafikEinfuegen
On Error Resume Next
...weiter mit Code
End Sub

Zu 2:
Ich hab die Ansätze ja schon unten im Code stehen.
    'Selection.ShapeRange.LockAspectRatio = msoTrue
    'Selection.ShapeRange.Height = 32.25
    'Selection.ShapeRange.Width = 39.75
    'Selection.ShapeRange.Rotation = 0#
einfach die Hochkomma weg und die Größe anpassen (rumspielen, ich weiß die Umrechnung von Pixel in cm nicht)

Klappt?

Gruß,
Nicole

------------------
Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 28. Jun. 2006 13:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Martin,
kleine Änderungen:
- Zellen (B5-B8) und folgende werden zusammengeführt
- das eingefügte Bild ist abhängig von Zellposition und Größe
- es wird mit der Größe 79.5 x 79.5 Pixel eingefügt, sollte ca. 2,8 cm sein
- es wird automatisch der letze Eintrag in Spalte B gesucht
Wenn jetzt alle Zeilen die Höhe 20 haben, sollte hübsch aussehen...tut's zumindest bei mir *g*
Code:
Sub GrafikEinfuegen()
On Error Resume Next
Dim i As Integer
'Cells.Select          hier wird die Zeilenhöhe auf 20 festgelegt
'Selection.RowHeight = 20
    For i = 5 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        Cells(i, 1).Select
        ActiveCell.FormulaR1C1 = "=MID(RC[+1],1,3)"
        Cells(i, 3).Select
        ActiveCell.FormulaR1C1 = "=MID(RC[-1],2,2)&MID(RC[-1],5,3)&MID(RC[-1],9,3)"
        Cells(i, 3).Select
        Range(Cells(i, 3), Cells(i + 3, 3)).Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Selection.Merge
        ActiveSheet.Pictures.Insert("C:\PDF\" & Cells(i, 1) & "\" & (Cells(i, 3).Value) & ".jpg").Select
            With Selection
                .ShapeRange.LockAspectRatio = msoFalse
                .Placement = xlMoveAndSize
                .PrintObject = True
                .ShapeRange.Height = 79.5
                .ShapeRange.Width = 79.5
            End With
    Next
  Columns("A:A").ClearContents
End Sub

Da ich den Makro-Recorder benutzt habe, sind da noch einige Sachen unschön, bzw. überflüssig, aber ich wollte es jetzt nicht rauslöschen, vielleicht kann man es ja nutzen für was auch immer

------------------
Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 28. Jun. 2006 13:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


ist.jpg


soll.jpg

 
EDIT:
UPS... mein Beitrag ist nicht auf den letzten von Dir bezogen... ich teste erst einmal... 
melde mich dann

---------------------------------------

Hallo Nicole, Danke Dir...
funktioniert soweit einwandfrei - bis auf die Ausrichtung der Bilder. Die Bilder fügen sich immer in der oberen linken Ecke von Zelle C4 - C8 - C12 usw an. Wünschenswert wäre allerdings die obere linke Ecke des Rechtecks welches in Zelle C4 liegt. Ist komisch zu erklären, ich mach dir mal ´ne Grafik.
Danke Dir
Gruß Martin

[Diese Nachricht wurde von Martin_0103 am 28. Jun. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 28. Jun. 2006 13:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Du willst unbedingt diese Textfelder nutzen, wa?
Kann ich aber auf die Schnelle nicht 
Falls es noch nicht funzt, Lösungsvorschlag: die Bilder nach Einfügen um 5 Pixel nach rechts und 5 Pixel nach unten verschieben natürlich Pixelzahl so anpassen, daß es paßt.:
Code:

...
            With Selection
                .ShapeRange.LockAspectRatio = msoFalse
                .Placement = xlMoveAndSize
                .PrintObject = True
                .ShapeRange.Height = 79.5
                .ShapeRange.Width = 79.5
                .ShapeRange.IncrementLeft 5#  'hier wird verschoben
                .ShapeRange.IncrementTop 5#
            End With
...

------------------
Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 28. Jun. 2006 14:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Nicole...
bin ich schwer zufrieden zu stellen? 

Du, es läuft zu meiner vollsten Zufriedenheit... ich kann mich nur nochmals bei Dir bedanken!!! Hast mir sehr geholfen - vorallem in welch einer Zeit! Klasse!

Lieben Gruß 

Martin   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 28. Jun. 2006 19:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

und nun das ganze ohne Vba 

gruss Thomas *bin heut blöd drauf*

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 27. Okt. 2006 11:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Forum,
ich stell hier das Makro nochmals mit zwei kleinen Änderungswünschen ein.
Seinerzeit sind wir von immer der gleichen Struktur der Nummern ausgegangen  ->  X11-222-333
daraus wurde der Bildername  ->  11222333.jpg
Nun ist ein Kollege auf die tolle Idee gekommen, eine zusätzliche neue Nummer zu kreieren -> X11-222-333-4
daraus wird dann der Bildname  ->  11222333-4.jpg

Änderungswunsch 1
Nun die Bitte, ist es möglich eine solche Änderung in dem Makro zu berücksichtigen? Für mich sind das böhmische Dörfer... Hut ab vor denen die das können und vor denen die hier helfen!!!

Hier das Makro:

Sub GrafikEinfuegen3()
    Dim intIndex As Integer, strPfad As String, shpRectangle As Shape
    On Error GoTo err_exit
    For intIndex = 4 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        strPfad = ("i:\PDF\" & Split(Cells(intIndex, 2).Value, "-")(0) & "\" & _
            Mid$(Replace(Cells(intIndex, 2).Value, "-", ""), 2) & ".jpg")
        With Range(Cells(intIndex, 3), Cells(intIndex + 3, 3))
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
                msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture strPfad
    Next
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub

Public Sub BilderLoeschen3()
    Dim sh As Object
    On Error GoTo err_exit

    For Each sh In ActiveSheet.Shapes
        If sh.Type = msoShapeRectangle Then
            sh.Select
                With Selection
                    .ShapeRange.Fill.Visible = msoFalse
                End With
        End If
    Next
    Exit Sub
err_exit:
    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
End Sub


Änderungswunsch 2 oder besser zusätzliches Makro
Ich würde ein Makro benötigen welches ich in Excel, Word oder auch Outlook per Button starten kann welches wie folgt arbeitet.

Es sollte ein Fragefenster "Grafik einfügen" aufgehen in das ich die Nummer X11-222-333 oder die Nummer X11-222-333-4 manuell eingebe. Mit der Bestätigung eines OK Buttons sollte die Grafik an der Cursorposition eingefügt werden (analog des o.s. Makros). Die Grafik kann ich dann mittels Maus positionieren.

Vielen lieben Dank

Gruß Martin


Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 27. Okt. 2006 12:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

zu 1 -
Code:
strPfad = ("i:\PDF\" & Mid$(Replace(Cells(intIndex, 2).Value, "-", "", , 2), 2) & ".jpg")

und zu 2 Aktive Zelle ist dort wo das Bild eingefügt werden soll
Code:
sTxt = InputBox("Bitte Eingabe tätigen:", "Grafik einfügen", Replace(ActiveCell.Offset(0, -1), "-", "", , 2))
könnte eine Lösung sein

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 27. Okt. 2006 12:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Matthias,

zu 1.:

Folgende Zeile austauschen:  

Code:

For intIndex = 5 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        strPfad = ("i:\PDF\" & Split(Cells(intIndex, 2).Value, "-")(0) & "\" & _
            Mid$(Replace(Cells(intIndex, 2).Value, "-", "", , 2), 2) & ".jpg")

Erklärung: ich ersetze nur noch 2 Stück Bindestriche:

Replace(Cells(intIndex, 2).Value, "-", "", , 2)

hier ist es die letzte 2, die die Anzahl der zu ersetzenden Zeichen bestimmt.

Zu Deinem 2. Problem: Stichwort ist (glaub ich) TextBox, da gibt es aber noch was zweites, der Begriff ist mir spotan entfallen  
Ich melde mich wieder, muß noch schaffen...


[edit] ach guck mal, da war schon jemand... Hallo Thomas! : )[/edit]

------------------
Gruß,
Nicole                          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

[Diese Nachricht wurde von runkelruebe am 27. Okt. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 27. Okt. 2006 15:20    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

ohne das jetzt mit dem Bildeinfügen geprüft zu haben -keine Lust mir so ein Verz. samt Bild zu erstellen :-)

zu 1

Code:
Sub GrafikEinfuegen3()
    Dim intIndex As Integer, strPfad As String, shpRectangle As Shape
    On Error GoTo err_exit
    For intIndex = 4 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        strPfad = ("i:\PDF\" & Mid$(Replace(Cells(intIndex, 2).Value, "-", "", , 2), 2) & ".jpg")
        strPfad = InputBox("Bitte Eingabe tätigen:", "Grafik einfügen", strPfad) 'optional
        With Range(Cells(intIndex, 3), Cells(intIndex + 3, 3))
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
                msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture strPfad
    Next
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub
und zu 2 Aufruf am besten über Tastenkürzel oder auch Button und makrozuweisen
Code:
Sub Grafikinput() 'Manuell - Aktive Zelle ist rechts der Nummer
    Dim intIndex As Integer, strPfad As String, shpRectangle As Shape
    On Error GoTo err_exit
   
    strPfad = InputBox("Bitte Eingabe tätigen:", "Grafik einfügen", _
    "i:\PDF\" & Mid$(Replace(ActiveCell.Offset(0, -1), "-", "", , 2), 2) & ".jpg")
        With Range(ActiveCell, ActiveCell.Offset(3, 0))
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
                msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture strPfad
 
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 30. Okt. 2006 08:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Nicole, Hallo Thomas,
vielen Dank für Eure Hilfe. Allerdings komm ich nicht ganz klar damit, die Änderung von Nicole:

Zitat:
Code:

For intIndex = 5 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        strPfad = ("i:\PDF\" & Split(Cells(intIndex, 2).Value, "-")(0) & "\" & _
            Mid$(Replace(Cells(intIndex, 2).Value, "-", "", , 2), 2) & ".jpg")


arbeitet unerwartend, d.h. es wird ein Rahmen eingefügt - allerdings tiefer als bei dem original Makro dafür aber "ohne" Bild.


Das Makro von Thomas verlangt eine Eingabe? Dieses sollte nicht sein, es sollte schon automatisch ablaufen.


Der Änderungswunsch ist:
X11-222-333      ->  11222333.jpg
X11-222-333-4    ->  11222333-4.jpg

Beide Varianten kommen vor!


Der Vorschlag von Thomas bezüglich dem 2. Wunsch geht soweit - jedoch wird kein Bild eingefügt! Evtl. hängt das an o.g. Problem!

Vielleicht habt ihr ja noch mal Zeit es anzuschauen.

Vielen Dank
Gruß Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 30. Okt. 2006 08:29    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Martin,
ich hab's jetzt nicht wieder komplett nachgestellt (so mit Anlegen von nem "PDF"-Ordner und mit den Bildern drin und so...), aber da wir ja nur eine Zeile verändert haben, müßte es eigentlich laufen.
Vorausgesetzt natürlich, daß die Pfad-Angaben immer noch : Ordner "PDF" auf Laufwerk "I", und die Bilder sind da auch tatsächlich drin!

Das mit dem eine Zeile tiefer liegt am Schleifenstart:
For intIndex = 5 To Cells(Rows.Count, 2).End(xlUp).Row Step 4

hier hab ich Dir versehentlich die Zeile vermurkst  , schreib anstatt 5 mal wieder ne 4 hin, dann paßt das Rechteck wieder 

Prüf doch mal mit dieser kleinen Änderung nochmal, und kontrolliere, ob die Ordnerstruktur vorhanden und gefüllt ist und wenn's wirklich nicht geht, dann stell' ich's mir heute nachmittag auch gerne nochmal nach.

Bis dahin!

------------------
Gruß,
Nicole                          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 30. Okt. 2006 09:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Nicole,
kleine Unterschiede, große Wirkung 
Es lag an der 5 !

Das Makro funktioniert!

Vielen vielen Dank
Gruß Martin

PS: leider finde ich diese 5 nicht bei dem anderen Makro 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 30. Okt. 2006 10:14    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Prima.

und zu 2.: Versuch mal dieses leicht geänderte:

Code:
Sub Grafikinput() 'Manuell - Aktive Zelle ist rechts der Nummer
    Dim intIndex As Integer, strPfad2 As String, shpRectangle As Shape
    On Error GoTo err_exit
   
   strPfad2 = "i:\PDF\" & InputBox("Bitte Eingabe tätigen:", "Grafik einfügen") & ".jpg"

        With Range(ActiveCell, ActiveCell.Offset(3, 0))
       
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
                msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture strPfad2
 
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub



in die Eingabeaufforderung jetzt nur noch die Bildnummer reinschreiben: Bsp: 111222333-4
das "I\PDF\" und das ".jpg" drumrum werden automatisch eingefügt.

------------------
Gruß,
Nicole                          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

[wie immer: wenn man schon 'nen VariablenNamen ändert, dann bitte auch überall     ]

[Diese Nachricht wurde von runkelruebe am 30. Okt. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 30. Okt. 2006 10:50    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


bef.jpg

 
Hallo Nicole,
geht noch nicht. Das Resultat sieht wie auf der Grafik aus. Der Bildrahmen wird der Zelle angepaßt!

Der Aufruf müßte meines Erachtens mit der vollen Nummer realisiert werden - sonst weiß man den Dateiordner nicht.

H11-002-206  ->  Ordner:  i:\pdf\H11\11002206.jpg

oder

H11-002-206-1  ->  Ordner:  i:\pdf\H11\11002206-1.jpg


Vielen Dank

Gruß Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 30. Okt. 2006 11:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

dieses H11 kann er sich aber nirgendwoher ziehen, also müßtest Du es mit eingeben:  Eingabe = H11\111222333-4
dann müßte es gehen.

zum Rechteck: das ist abhängig von der Zelle, in der Du beim Makro-Aufruf stehst und doch auch so gewollt!?

Zitat:
Die Grafik kann ich dann mittels Maus positionieren.

OK, am Mauszeiger wird es noch nicht eingefügt, aber das können wir auch anders haben, ohne Rechteck, nur die Grafik einfügen:

Code:
Sub Grafikinput() 'Manuell - Aktive Zelle ist rechts der Nummer
    Dim intIndex As Integer, strPfad3 As String, shpRectangle As Shape
    On Error GoTo err_exit
   
  strPfad3 = "i:\PDF\" & InputBox("Bitte Eingabe tätigen:", "Grafik einfügen") & ".jpg"
        ActiveSheet.Pictures.Insert(strPfad3).Select
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub

check es und berichte 

------------------
Gruß,
Nicole                          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 30. Okt. 2006 11:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Nicole,
super Sache, es funktioniert...!!!
Danke Dir!
Ganz lieben Gruß aus Hessen
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

scrarat
Mitglied
Grafiker

Sehen Sie sich das Profil von scrarat an!   Senden Sie eine Private Message an scrarat  Schreiben Sie einen Gästebucheintrag für scrarat

Beiträge: 1
Registriert: 09.04.2013

erstellt am: 09. Apr. 2013 01:14    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo liebes Forum,

dieser Code scheint, als sei er genau dass, was ich gesucht habe...
Nur leider habe ich was VBA angeht überhaupt keine Ahnung, wie ich den Code eingeben muß, und vor allem, welche Zellen für den Dateinnamen stehen...

Mein Wunsch wäre folgendes:
Eine Zelle (Dropdownfeld, Tabellenname: Auswahl, Zelle:C1) zur Auswahl des Dateinamens. Der Dateiname ist gleich der Artikelnr.
Der Pfad: H:\Produktbilder\    dateiformat bleibt jpg.

Die Bildaktualisierung sollte nach Auswahl durch das Dropdownfeld erfolgen (nur wenn das geht...)

Und wenn es geht, vielleicht eine kleine Anleitung, wie ich den Code einfügen muß, damit es funktioniert.

Es wäre mir eine große Hilfe...

Danke im Voraus,

Andreas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8017
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 09. Apr. 2013 03:18    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich


2013-04-09-VBA-wohin-damit.PNG

 
Moin Andreas,

vorab: gar keine Ahnung von VBA ist viel zu wenig Ahnung von VBA ;-)
Änder das, Tutorialempfehlungen findest Du u.a.hier im Forum.

Zitat:
Original erstellt von scrarat:
Mein Wunsch wäre folgendes:
Eine Zelle (Dropdownfeld, Tabellenname: Auswahl, Zelle:C1) zur Auswahl des Dateinamens. Der Dateiname ist gleich der Artikelnr.
Der Pfad: H:\Produktbilder\    dateiformat bleibt jpg.

Die Bildaktualisierung sollte nach Auswahl durch das Dropdownfeld erfolgen (nur wenn das geht...)


In diesem (steinalten  ) thread ging es bislang darum, eine ganze Reihe von Bildern einzufügen, daher auch die Schleifen drumrum.

Wenn ich Deine Anfrage richtig deute, suchst Du was ganz anderes, ein einfaches:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPfad7$
'Nur Änderungen von C1 sind interessant, daher aus Performancegründen Bereich einschränken!
If Not Intersect(Target, Range("C1")) Is Nothing Then
    strPfad7 = " H:\Produktbilder\ " & (ActiveCell.Value) & ".jpg"
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Pictures.Insert (strPfad7)
End If
End Sub
sollte Dir laut Beschreibung schon reichen.

Einfügen musst Du diesen kompletten Code im Bereich des worksheets, auf dem die Sache stattfinden soll, siehe angehängten screenshot.

Das Dropdown hast Du doch hoffentlich schon? Wenn nicht: (Angaben für Excel2010, bitte Systeminfo ergänzen)
Ribbon: Daten > Gruppe: Datentools > Befehl: Datenüberprüfung > Zulassen: Liste > Quelle: an- oder eingeben [ =$A$1:$A$3 oder rot;gelb;blau ]

HTH 

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Beverly
Mitglied
Dipl.-Geologe (Rentner)


Sehen Sie sich das Profil von Beverly an!   Senden Sie eine Private Message an Berverly  Schreiben Sie einen Gästebucheintrag für Berverly

Beiträge: 384
Registriert: 11.08.2007

erstellt am: 11. Apr. 2013 08:54    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hi @All,

nur mal als Tipp am Rande: wenn man nur 1 Adresse überwachen möchte, benötigt man kein Intersect, da reicht die Zelladresse

Code:
If Target.Address = "$C$1" Then

Wichtig dabei - die Adresse muss absolut angegeben sein. Will man die Adresse (obwohl dazu keine Notwendigkeit besteht) unbedingt relativ angeben, geht das mit einem Zusatz ebenfalls

Code:
If Target.Address(False, False) = "C1"

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Martin_0103
Mitglied



Sehen Sie sich das Profil von Martin_0103 an!   Senden Sie eine Private Message an Martin_0103  Schreiben Sie einen Gästebucheintrag für Martin_0103

Beiträge: 181
Registriert: 05.02.2003

3,4 GHz - Quadro 4000 - 12 GB RAM - WIN7 - IV2010 SP3

erstellt am: 16. Apr. 2014 07:29    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Forum,
nun haben wir nach langer Zeit auf Excel 2010 umgestellt und siehe da, das Makro läuft nicht mehr. Wäre schön, wenn wir das wieder zum Laufen bringen würden.
Vielen Dank schon mal
Gruß Martin

Code:
Sub GrafikEinfuegen3()
    Dim intIndex As Integer, strPfad As String, shpRectangle As Shape
    On Error GoTo err_exit
    For intIndex = 4 To Cells(Rows.Count, 2).End(xlUp).Row Step 4
        strPfad = ("i:\PDF\KVD\" & Split(Cells(intIndex, 2).Value, "-")(0) & "\" & _
            Mid$(Replace(Cells(intIndex, 2).Value, "-", "", , 2), 2) & ".jpg")
        With Range(Cells(intIndex, 3), Cells(intIndex + 3, 3))
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
                msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture strPfad
    Next
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlausReiff
Mitglied
Sachbearbeiter

Sehen Sie sich das Profil von KlausReiff an!   Senden Sie eine Private Message an KlausReiff  Schreiben Sie einen Gästebucheintrag für KlausReiff

Beiträge: 3
Registriert: 13.11.2014

erstellt am: 13. Nov. 2014 10:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich


Excelliste.pdf

 
Hallo Nicole,
ich schaffe es einfach nicht das Makro richtig abzuändern.

Ich habe einen Excelliste (Exc.2007)siehe Anlage und möchte die Bilder dazu automatisch einfügen.

Der Artikelpfad steht in Spalte I (mehrfach)- Das Bild soll in Spalte
J eingefügt werden - Bildgrösse ca. 3 cm. Immer beginnend am zuerst
genannten Bildpfad.

Der Bildpfad ist:

F:\Muster\FS2015\Niedrig\20522_501.jpg

F:\Muster\bleibt immer gleich alle anderen Angaben ändern sich im Pfad.

mfg
Klaus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 13. Nov. 2014 21:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich


picinComment.zip

 
Es ist egal ob >F:\Muster< immer gleich bleibt, wenn die volle Adressierung in den Zeilen der Spalte I geben ist.

Da nicht bekannt ist welche Variante vom Code man anpassen will, gibt es halt mal eine Variante im Kommentar     

Klarer Input -klarer Output

Code:
Sub picincomm()

    Dim intIndex As Integer, strPfad As String, shpRectangle As Shape
    On Error GoTo err_exit
    For intIndex = 2 To Cells(Rows.Count, 9).End(xlUp).Row Step 1  '= Spalte I
        strPfad = Cells(intIndex, 9)

If Not Cells(intIndex, 10).Comment Is Nothing Then
                Cells(intIndex, 10).Comment.Delete
            End If
    Cells(intIndex, 10).AddComment
    Set objCom = Cells(intIndex, 10).Comment.Shape
    With objCom
        .Fill.UserPicture strPfad
        .Width = 100
        .Height = 100
    End With


    Next
    Exit Sub
err_exit:
'    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, vbCritical, "Fehlermeldung"
        Resume Next
End Sub


Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2162
Registriert: 02.05.2006

Office 2010
Visual Basic

erstellt am: 13. Nov. 2014 21:52    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Welchen Code benutzt Du?
poste ihn doch mal ...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlausReiff
Mitglied
Sachbearbeiter

Sehen Sie sich das Profil von KlausReiff an!   Senden Sie eine Private Message an KlausReiff  Schreiben Sie einen Gästebucheintrag für KlausReiff

Beiträge: 3
Registriert: 13.11.2014

erstellt am: 17. Nov. 2014 09:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Guten Tag KlaK,

ich habe keinen Code - ich habe mit den oben genannten Formeln
ausprobiert.
Leider habe ich wenig bis keine Ahnung von Makros.
Ich hoffe aus Hilfe

mfg
Klaus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 17. Nov. 2014 12:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von KlausReiff:
ich habe keinen Code - ich habe mit den oben genannten Formeln
ausprobiert.


Du hast die Codeschnippsel als Formel eingegeben?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KlausReiff
Mitglied
Sachbearbeiter

Sehen Sie sich das Profil von KlausReiff an!   Senden Sie eine Private Message an KlausReiff  Schreiben Sie einen Gästebucheintrag für KlausReiff

Beiträge: 3
Registriert: 13.11.2014

erstellt am: 17. Nov. 2014 15:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

Hallo Thomas

ja habe ich - Leider ohne Erfolg.Kannst du mir mit einem entsprechenden
Makro weiterhelfen ?

mfg
Klaus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2896
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 17. Nov. 2014 16:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Martin_0103 10 Unities + Antwort hilfreich

< Die codeschnippsel sind keine formeln, sonden schon entsprechende codes für ein makro >

Ein bsp. wäre ja in der gezippten Datei Picincomment vorhanden.

Datei entpacken,
die Datei mit Excel öffen,
die Bsp. Pfade anpassen
und auf den Schalter >Klick mich< drücken

sollte in der nebenstehenden Spalte die Bilder in das Kommentarfeld verfrachten.

Aber dies ist ja nur ein Bsp.

Deine genaue Aufgabenstellung ist nicht bekannt:
- vollautomatisch
- oder nur selektiv
- oder gar als neue Funktion aka = Bild(F2)

und da du die Codeschnippsel als Formel eingegeben hast...
muss man ganz von vorn anfangen - was ist Excel, Formeln und was ist ein Makro -

weil schliesslich musst du es ja bedienen können und ggf. auch wissen was passiert um es vielleicht irgendwann anzupassen ;-)

Es Bringt nicht viel, wenn wir dir ein Code erstellen und du weisst nicht wo und wohin mit dem Code  - (Alt&F11) VBA Umgebung)
Ebensowenig wenn du einen Bsp Code nicht für deine Bedürfnisse anpassen kannst.

Daher Klarer Input - Was genau ist die Aufgbenstellung, ggf. mit Bsp-Excel-Mappe (sensible Daten durch Dummy Werte ersetzen)
Damit macht man es den Helfenden etwas einfacher.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz