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
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