foto(s) toevoegen aan worksheet

Status
Niet open voor verdere reacties.

ottoo

Gebruiker
Lid geworden
28 feb 2018
Berichten
9
Goedemorgen Helpmij !

Ik ben helemaal nieuw hier op t forum , en ik heb een vraag die ik zo goed mogelijk zal
proberen duidelijk te maken :

Ik heb een worksheet ( Zie bijage )waarop ik in eerste instantie het wilde regelen dat ik een foto uit een map
kon laten zien met VBA Code , voor de code die ik hiervoor gebruikte zie hieronder .

Dit werkt prima zolang je dit met 1 foto wil doen , maar zoals je in de bijlage kunt zien wil ik graag
twee fotos kunnen zoeken en laten zien. Maar dan werkt de code niet meer goed : als ik 1 van de 2 foto's
verander dan verdwijnt de andere foto , Ik snap dat dit gebeurd maar ik weet niet hoe ik de code voor de
buttons moet veranderen zodat de ik ze onafhankelijk van elkaar kan updaten , kan iemand mij hier mee helpen ?

Code:
Private Sub CmdDisplayPicture_Click()
Application.ScreenUpdating = False
'Dim myObj
'Dim Pictur
'Set myObj = ActiveSheet.DrawingObjects
'For Each Pictur In myObj
'If Left(Pictur.Name, 7) = "Picture" Then
'Pictur.Select
'Pictur.Delete
'End If
'Next

Dim PictureName As String, T As String

myDir = "G:\SNA Services\Q - EH&SS\_hfst 7 registraties\actiepuntenlijst\Cora\Picture\"
PictureName = Range("B42")
T = ".JPG"

Range("B67").Value = PictureName
On Error GoTo errormessage:
ActiveSheet.Shapes.AddPicture Filename:=myDir & PictureName & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=38, Top:=677, Width:=400, Height:=314

errormessage:
If Err.Number = 1004 Then
MsgBox "File does not exist." & vbCrLf & "Check filename!"
Range("B42").Value = ""
Range("B67").Value = ""
End If
Application.ScreenUpdating = True
End Sub

Ik hoop dat ik de code op juiste manier heb toegevoegd

Ben erg benieuwd of iemand mij kan helpen

Gr.
Herman
 

Bijlagen

  • Example.xlsx
    1,7 MB · Weergaven: 47
Laatst bewerkt:
Welkom op HelpMij! Zou je in de laatste CODE tag nog een / willen zetten? Nu heb je twee begintags getypt (ik neem aan dat je ze getypt hebt, en niet, zoals de meeste luie personen, de knop # hebt gebruikt ;) ) en is de code dus niet goed opgemaakt.
 
Gaat prima met:

Code:
Sub M_snb()
  c00 = "G:\OF\"

  Sheet1.Shapes.AddPicture c00 & Dir(c00 & "*.jpg"), -1, -1, Columns(1).Left, Rows(2).Top, 200, 200
  Sheet1.Shapes.AddPicture c00 & Dir(), -1, -1, Columns(10).Left, Rows(2).Top, 200, 200
End Sub
 
Laatst bewerkt:
goedendag SNB,

Dankje wel voor je reactie en dat je naar mijn probleempje gekeken hebt ,
Ik denk alleen dat de oplossing er nu nog niet is ,
de code geeft de fotoos prima weer zoals ik het wil met de code , alleen wil ik graag
dat als ik een nieuwe foto zoek dat die dan wordt weergegeven en dat de oude verwijderd wordt ,
echter met de huidige code wordt alles verwijderd , dus als ik een nieuwe foto op de ene plaats vervang dan wordt de eerste foto verwijderd maar
ook de 2de foto wordt verwijderd , dat wil ik niet , ik will graag dat ik ze onafhankelijk van elkaar werken.

Onderstaande code heb ik on hold gezet omdat die ervoor zorgt dat dit gebeurd ( en dit werkt prima zolang dit gedaan wordt met 1 foto ) maar omdat de
code ervoor zorgt dat alle objects worden verwijderd gaat ook de andere foto weg .

Dus ik denk dat in het stuk code wat ik on hold gezet heb iets moet veranderen om deze twee fotoos onfhankelijk van elkaar te kunnen updaten en on oude inforamtie eruit moet
kunnen laten halen .

Tis een heel verhaal maar ik weet ook niet hoe ik t anders duidelijk moet maken :

Code die ik on hold heb gezet :

Code:
'Dim myObj
'Dim Pictur
'Set myObj = ActiveSheet.DrawingObjects
'For Each Pictur In myObj
'If Left(Pictur.Name, 7) = "Picture" Then
'Pictur.Select
'Pictur.Delete
'End If
'Next

Ik hoop dat hier een oplossing voor is ?

Gr.
Herman
 
Plaats een relevant voorbeeldbestand. Je hebt nu alles in 1 plaatje staan en dat heeft geen enkel nut.
 
`Hallo VenA

Ik heb de complete worksheet als bijlage ( book2) erbij gedaan , ik hoop dat je dat bedoelde ,
De eerdere bijlage was eigenlijk een selectie van deze worksheet .


Gr
Herman
 

Bijlagen

  • Book2.xlsm
    621,1 KB · Weergaven: 48
Plaatjes en toestanden als opmaak zijn niet echt mijn ding. Wat wil je nu precies?

In A42 wat willekeurigs invoeren en dan met een druk op de knop maar hopen dat het gevonden wordt? Of moet hier een keuzelijst komen met de beschikbare plaatjes? Staan al deze plaatjes in dezelfde map? Blijft het bij 2 plaatjes of wil je er in de toekomst meer?
Hoe meer info, hoe beter je vooruit geholpen gaat worden.
 
hallo VenA ,

Dankje dat je naar mijn 'ding 'wilt kijken !

Tis niet niet echt simpel om zoiets echt duidelijk uitgelegd te krijgen merk ik nu , maar ik ga toch nog een poging doen :

Het formulier zoals in de bijlage (Book2) is een onderdeel van een workbook met een database waarin
allerlei incidenten , observaties etc. worden geupdate door verschillende mensen in het bedrijf . Een aantal velden uit deze database zijn opgenomen in het formulier (Book 2 ) , gewoon omdat het op verschillende momenten nodig kan zijn om een incident met info uit te kunnen printen.
Een van de mogelijkheden om een incident of gebeurtenis duidelijk te maken op papier is door middel van foto,
vandaar dat ik graag de mogelijkheid wil hebben om een foto op het formulier te plaatsen.
De fotoos die kunnen worden gebruikt staan inderdaad op een aparte map , en vooralsnog is het idee om nieuwe fotoos te uploaden in deze map met de naam van het record nummer waar het bij hoort, zodat er niet hoeft worden gezocht in de map naar de juiste foto. (als hier andere betere methodes voor zijn hoor ik dat natuurlijk graag)

Ik ben in eerste instantie begonnen om 1 foto op het formulier te krijgen en met de code zoals bijgevoegd werkt dit ook prima , je vult filename in en drukt op de knop en voila de foto verschijnt , als er een filename wordt ingevuld komt die foto te voorschijn , en de oude foto wordt verwijderd . Juist dit verwijderen van de oude foto is belangrijk om te zorgen dat er straks als er meerdere mensen mee gaan werken niet 20 fotoos
boven opelkaar staan die dan manual gedelete moeten worden.

Toen dit met 1 foto goed werkte dacht ik , dat moet ook met twee fotoos lukken , maar dan werkt de code niet meer omdat de code zegt dat alle objecten uit t formulier moeten worden verwijderd als er een nieuwe foto wordt gevraagd , terwijl de code nu moet zorgen dat alleen de oude foto op de plaats waar ik een nieuwe foto vraag moet worden verwijderd en niet ook die andere foto , kortom ik moet beide fotoos onafhankelijk van elkaar kunnen laten werken .

De vraag is nu of dat kan , dus of de huidige code hierop aangepast kan worden ?? of dat ik dit wellicht op een geheel andere manier moet oplossen ?

Gr.
Herman
 
Code in bladmodule van toepassing.
Code:
Private Sub CommandButton1_Click()
    On Error Resume Next
       Shapes("Afbeelding 1").Delete
    On Error GoTo 0
c00 = "D:\ottoo\" & Range("B42").Value & ".jpg"
    Shapes.AddPicture c00, -1, -1, Columns(2).Left, Rows(45).Top, 420, 335
    Shapes(Range("B42").Value & ".jpg").Name = "Afbeelding 1"
End Sub

Private Sub CommandButton2_Click()
 On Error Resume Next
    Shapes("Afbeelding 2").Delete
    On Error GoTo 0
c00 = "D:\ottoo\" & Range("G42").Value & ".jpg"
    Shapes.AddPicture c00, -1, -1, Columns(7).Left, Rows(45).Top, 420, 335
    Shapes(Range("G42").Value & ".jpg").Name = "Afbeelding 2"
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan