Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Bilder per VBA finden (Worksheets) und kopieren
zurück: Makro für Plot der variable Anzahl von Datenserien hat weiter: Nur einzelne Module schützen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
mark3001
Im Profil kannst Du frei den Rang ändern


Verfasst am:
12. Feb 2009, 16:29
Rufname:

Bilder per VBA finden (Worksheets) und kopieren - Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Hallo @ll,

habe in einer Liste für eine Projektarbeit folgendes Problem:

Ich möchte per Knopfdruck in verschiedenen Worksheets nach Bildern suchen, die dort bereits eingefügt sind. Die Bilder sollen kopiert und an einer bestimmten Stelle meines Workbooks wieder eingefügt werden.

Die Bilder die in meinem Workbook vorhanden sind werden ja standartmäßig von Excel "Bild 1", "Bild 2", ... usw benannt.

Wenn ich jetzt per Code nach diesen Bildern suche, bekomme ich immer die Meldung, Objekt nicht vorhanden.


Hier mal ein Beispiel das funktioniert (allerdings sucht er hier nach Bildern auf exteren Pfad - so möchte ich das nicht haben):

Private Sub CommandButton3_Click()
'Sub PictureGenauInEinenBereichEinfuegen()
Dim vntPathAndFileName As Variant
Dim rngZelle As Range
Dim sngTop As Single
Dim sngLeft As Single
Dim sngWidth As Single
Dim sngHeight As Single
Dim picPic As Excel.Picture
Dim wksT As Worksheet
Set wksT = ActiveWorkbook.Worksheets("Berechnung") 'Beispiel

Set rngZelle = wksT.Range(wksT.Cells(19, 8), wksT.Cells(40, 13)) 'Beispiel


sngTop = rngZelle.Top
sngLeft = rngZelle.Left
sngHeight = wksT.Cells(rngZelle.Row + rngZelle.Rows.Count, rngZelle.Column).Top - sngTop
sngWidth = wksT.Cells(rngZelle.Row, rngZelle.Column + rngZelle.Columns.Count).Left - sngLeft

vntPathAndFileName = Application.GetOpenFilename( _
FileFilter:="JPEG Files (*.jpg), *.jpg", _
Title:="Meine Bilder ", _
MultiSelect:=False)
If VarType(vntPathAndFileName) = vbBoolean Then
MsgBox "Abgebrochen!"
Else
wksT.Unprotect
'wenn schon vorhanden löschen
On Error Resume Next
wksT.Shapes("MeinBild").Delete
On Error GoTo 0

Set picPic = wksT.Pictures.Insert(vntPathAndFileName)
picPic.Top = sngTop
picPic.Left = sngLeft
picPic.Height = sngHeight
picPic.Width = sngWidth
picPic.Placement = xlMoveAndSize
picPic.Name = "MeinBild"
'wksT.Protect
End If
'End Sub



Hoffe es kann mir jemand weiterhelfen.

Gruß
mark
Phelan XLPH
Fortgeschritten


Verfasst am:
12. Feb 2009, 17:16
Rufname: Phelan


AW: Bilder per VBA finden (Worksheets) und kopieren - AW: Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Hallo ,

Bilder werden alle in Blatt "Bildersammlung" kopiert und
angeordnet. Gegebenenfalls Anpassen

Code:
Sub BilderSammeln()
Dim s As Shape
Dim wks As Worksheet
Dim wksZ As Worksheet
Dim dblTop As Double
Dim dblLeft As Double

Application.ScreenUpdating = False
Set wksZ = Worksheets("Bildersammlung") 'Anpassen

'Kopieren
For Each wks In ThisWorkbook.Worksheets
    If wks.Name <> wksZ.Name Then
        For Each s In wks.Shapes
            If LCase(s.AlternativeText) Like "*.jpg" Or _
               LCase(s.AlternativeText) Like "*.bmp" Or _
               LCase(s.AlternativeText) Like "*.gif" Then
                s.Copy
                wksZ.Paste
            End If
        Next
    End If
Next

'Anordnung Untereinander
For Each s In wksZ.Shapes
    s.Top = dblTop
    s.Left = dblLeft
    dblTop = dblTop + s.Height
    dblLeft = 0
Next
Application.ScreenUpdating = False
End Sub


Rückmeldung bitte ..Danke!

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
mark3001
Im Profil kannst Du frei den Rang ändern


Verfasst am:
12. Feb 2009, 17:43
Rufname:

AW: Bilder per VBA finden (Worksheets) und kopieren - AW: Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Hallo Glücksritter76,

also der erste Versuch ist nicht so geglückt.... es wurden keine Bilder "gesammelt"

Ich werde dien Code mal etwas unstricken und später noch mal bescheid geben.

Danke erstmal
mark3001
Im Profil kannst Du frei den Rang ändern


Verfasst am:
12. Feb 2009, 17:57
Rufname:

AW: Bilder per VBA finden (Worksheets) und kopieren - AW: Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Also alles bisher leider erfolglos...

wie würdet Ihr vorgehen um nach einem Bild (z.B Bild 38) im Workbook zu suchen um es in einem anderen Worksheet wieder einzufügen?

Das ganze soll ja später mal so funktionieren:

ich suche über ein Makro einen Wert. Zu diesem Wert gibt es in meiner Liste ein passendes Bild. Jetzt soll ja das Bild "aufgegriffen" und weiter verarbeitet (kopiert/eingefügt) werden....


Vielleicht hat ja noch jemand einen Vorschlag.

Gruß
mark
Phelan XLPH
Fortgeschritten


Verfasst am:
12. Feb 2009, 18:10
Rufname: Phelan

AW: Bilder per VBA finden (Worksheets) und kopieren - AW: Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Wenn in den Namen der Bilder "Bild" oder "Grafik" vorkommen, dann
dann ändere den obigen code folgende ab:

Code:
        For Each s In wks.Shapes
            If s.Name Like "*Grafik*" Or _
               s.Name Like "*Bild*" Then
                s.Copy
                wksZ.Paste
            End If
        Next

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
Gast



Verfasst am:
13. Feb 2009, 12:17
Rufname:


AW: Bilder per VBA finden (Worksheets) und kopieren - AW: Bilder per VBA finden (Worksheets) und kopieren

Nach oben
       Version: Office 2003

Hallo, es funktioniert!!! Hab den Code allerdings für meine Bedürfnisse angepasst.

Aber es läuft jetzt sauber durch.

Here we go:

Private Sub CommandButton4_Click()

Dim s As Shape
Dim wks As Worksheet
Dim wksZ As Worksheet
Dim dblTop As Double
Dim dblLeft As Double


Dim strBildname As String
strBildname = ThisWorkbook.Worksheets("Berechnung").Range("A22")


Dim rngZelle As Range
Dim sngTop As Single
Dim sngLeft As Single
Dim sngWidth As Single
Dim sngHeight As Single
Dim picPic As Excel.Picture
Dim wksT As Worksheet
Set wksT = ActiveWorkbook.Worksheets("Berechnung") 'Beispiel
On Error Resume Next
wksT.Shapes("MeinBild").Delete
On Error GoTo 0

Set rngZelle = wksT.Range(wksT.Cells(19, 8), wksT.Cells(40, 13)) 'Beispiel


sngTop = rngZelle.Top
sngLeft = rngZelle.Left
sngHeight = wksT.Cells(rngZelle.Row + rngZelle.Rows.Count, rngZelle.Column).Top - sngTop
sngWidth = wksT.Cells(rngZelle.Row, rngZelle.Column + rngZelle.Columns.Count).Left - sngLeft






Application.ScreenUpdating = False
Set wksZ = Worksheets("Berechnung") 'Anpassen

'Kopieren
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> wksZ.Name Then
For Each s In wks.Shapes
If s.Name Like strBildname Then
s.Copy
wksZ.Paste
End If
Next
End If
Next

'Anordnung Untereinander
For Each s In wksZ.Shapes
If s.Name Like strBildname Then
s.Top = sngTop
s.Left = sngLeft
s.Height = sngHeight
s.Width = sngWidth
s.Name = "MeinBild"
'dblTop = dblTop + s.Height
'dblLeft = 0
End If
Next
Application.ScreenUpdating = False

End Sub


Danke für die Hilfe!
Gruß
mark
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Blatt kopieren 6 Noby 748 15. Aug 2005, 13:44
noby Blatt kopieren
Keine neuen Beiträge Excel Formeln: Formaln kopieren/Absolute Zellen ersetzen DRINGEND! 2 Craig Marduk 1627 15. Aug 2005, 08:06
Craig Marduk Formaln kopieren/Absolute Zellen ersetzen DRINGEND!
Keine neuen Beiträge Excel Formeln: nur Zahlenwerte welche mit Formeln hinterlegt sind kopieren 2 Ina-Ina 1640 27. Jul 2005, 10:28
Ina-Ina nur Zahlenwerte welche mit Formeln hinterlegt sind kopieren
Keine neuen Beiträge Excel Formeln: Formel finden! 2 ekon 692 22. Jul 2005, 15:48
Sabine23 Formel finden!
Keine neuen Beiträge Excel Formeln: Makro per Button ausführen lassen und if then problem 5 Darwin 3876 09. Mai 2005, 14:57
Darwin Makro per Button ausführen lassen und if then problem
Keine neuen Beiträge Excel Formeln: Wenn Bedingung ganze Zeile in endere Arbeitsmappe kopieren 2 Unregistered7 1556 05. Mai 2005, 22:32
Gast Wenn Bedingung ganze Zeile in endere Arbeitsmappe kopieren
Keine neuen Beiträge Excel Formeln: Formulartextfelderinhalt per Button in anderes Tabellenblatt 3 Blubberbernd 1232 10. Apr 2005, 10:49
fl618 Formulartextfelderinhalt per Button in anderes Tabellenblatt
Keine neuen Beiträge Excel Formeln: Frontpage soll per link in eine excel tabelle verweisen 3 Darkspawn 1636 04. März 2005, 16:46
Hübi Frontpage soll per link in eine excel tabelle verweisen
Keine neuen Beiträge Excel Formeln: Kann Fehler nicht finden 2 sreuber 492 22. Jan 2005, 11:22
Gast Kann Fehler nicht finden
Keine neuen Beiträge Excel Formeln: Verknüpfungen zu anderen Datenquellen finden 2 Guido05 2036 12. Jan 2005, 16:21
Gast Verknüpfungen zu anderen Datenquellen finden
Keine neuen Beiträge Excel Formeln: Formel mit "festem" Wert kopieren 2 sebbi 1937 08. Dez 2004, 20:36
sebbi Formel mit "festem" Wert kopieren
Keine neuen Beiträge Excel Formeln: Teile aus Zellen ersetzen und kopieren?? 2 Marbi 1145 03. Dez 2004, 14:49
Gast Teile aus Zellen ersetzen und kopieren??
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: HTML CSS