Probleem met overdracht foto's van ene blad naar ander via VBA

Status
Niet open voor verdere reacties.

Ilhan

Nieuwe gebruiker
Lid geworden
4 aug 2011
Berichten
1
Probleem is ;
Ik zou graag gegevens van verschillende sheets die ik heb in mijn werkmap willen overbrengen naar een vaste plaats in een sheet in dezelfde werkmap.Dit heb ik alles in orde maar met de overbreng van foto's heb ik problemen.
Als ik de programma run krijg ik een fout melding 1004 " eigenschap pictures van klasse Worksheet kan niet worden opgehaald"
Ik zal de programma ook als picture in bijlage zetten zo dat u kan zien wat ik gedaan heb.
Ik krijg de foutmelding op de gele lijn waar ActiveSheet.Pictures("spelerfoto").Copy staat met de foutmelding zoals hierboven geschreven.

hieronder de programma die ik heb geschreven;
Sub gegevensspelerskiezen()
'
' gegevensspelerskiezen Macro
Application.ScreenUpdating = False
spelerzoek = Cells(3, 7).Value
Sheets("Infoblad Premies van Spelers").Select
Cells(1, 1).Activate
Cells.Find(What:=spelerzoek, After:=ActiveCell, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
spelernr = Cells(ActiveCell.Row, 1)

Sheets("Infoblad spelers").Select

Columns("A:A").Select
Selection.Find(What:=spelernr, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
speleradres = Cells(ActiveCell.Row, 4).Value
spelerpostcode = Cells(ActiveCell.Row, 5).Value
spelerplaats = Cells(ActiveCell.Row, 6).Value
spelergebdatum = Cells(ActiveCell.Row, 7).Value
spelergebplaats = Cells(ActiveCell.Row, 8).Value
spelertelnr = Cells(ActiveCell.Row, 10).Value
spelergsmnr = Cells(ActiveCell.Row, 11).Value
speleremail = Cells(ActiveCell.Row, 12).Value
spelerrijksregnr = Cells(ActiveCell.Row, 17).Value
spelermutualiteit = Cells(ActiveCell.Row, 22).Value
spelerfunctie = Cells(ActiveCell.Row, 23).Value

Sheets("Foto Spelers").Activate

Cells(1, 1).Activate
Cells.Find(What:=spelerzoek, After:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
spelerfoto = ActiveCell.Value

ActiveSheet.Pictures("spelerfoto").Copy ( op deze lijn heb ik foutmelding!!!)
Sheets("draaitabel oefening").Activate
Range("b3").Select

Do Until ActiveCell = ""

ActiveSheet.Paste
Loop


Cells(4, 7).Value = speleradres
Cells(5, 7).Value = spelerpostcode
Cells(6, 7).Value = spelerplaats
Cells(7, 7).Value = spelergebdatum
Cells(8, 7).Value = spelergebplaats
Cells(3, 10).Value = spelertelnr
Cells(4, 10).Value = spelergsmnr
Cells(5, 10).Value = speleremail
Cells(6, 10).Value = spelerrijksregnr
Cells(7, 10).Value = spelermutualiteit
Cells(8, 10).Value = spelerfunctie



Application.ScreenUpdating = True

End Sub

Kan iemand me hier mee helpen aub?
mvg,
Ilhan :rolleyes:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan