IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Excel
  New Posts New Posts RSS Feed - Inserimento foto automatico in determinate celle
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

Inserimento foto automatico in determinate celle

 Post Reply Post Reply
Author
Message
Paolinho8cn93 View Drop Down
Nuovo Utente
Nuovo Utente
Avatar

Joined: 03/Apr/2019
Location: Milano
Status: Offline
Points: 30
Post Options Post Options   Thanks (0) Thanks(0)   Quote Paolinho8cn93 Quote  Post ReplyReply Direct Link To This Post Topic: Inserimento foto automatico in determinate celle
    Posted: 04/Apr/2019 at 10:14
Buongiorno!
Sto lavorando da alcuni mesi sul un progetto in Excel e sono arrivato quasi alla conclusione...
Come ultimo passaggio vorrei riuscire a fare in modo che con un determinato nome di un giocatore si riuscisse a fare in modo che si metta in automatico la foto del giocatore, magari anche adattata alla dimensioni delle celle in cui va inserita l'immagine...
Vi metto uno screenshot in modo che possiate vedere di cosa sto parlando 
Le immagini che dovrei mettere per i 7 giocatori titolari si trovano in questo percorso (C:\Users\ASUS\Desktop\Francia\EDF19\DATABASE GIOCATORI)...
Visto che nella cella F2 viene scritto il nome della Squadra, secondo voi Ŕ meglio anche per le foto vada anche a organizzarle in cartelle in base alla squadra?
es. se gioco contro ITALY (come nello screenshot) Ŕ pi¨ semplice che il percorso delle foto sia: C:\Users\ASUS\Desktop\Francia\EDF19\DATABASE GIOCATORI\ITALY ?

Nel foglio la tabella che funge come elenco dei giocatori della squadra avversaria si compila in modo automatico avendo creato una macro che va a prendere i nomi dei giocatori da un'altro file e la compila in base al numero di maglia..
Successivamente a questo vado ad inserire il probabile sestetto titolare:
es nella cella Q11 scrivo il numero di maglia del giocatore 6 che in automatico va ad inserire il Cognome del giocatore nella cella Q12 mediante la ricerca del valore Q11 nella tabella con l'elenco dei giocatori.
fatto per gli altri 6 Giocatori vorrei che a questo punto si inserissero in automatico le foto dei giocatori (nel caso del giocatore nelle cella Q12 la foto deve essere inserita nella cella Q7)...

Come devo fare? Mi potete aiutare?

Vi ringrazio 
Back to Top
Sponsored Links


Back to Top
Paolinho8cn93 View Drop Down
Nuovo Utente
Nuovo Utente
Avatar

Joined: 03/Apr/2019
Location: Milano
Status: Offline
Points: 30
Post Options Post Options   Thanks (0) Thanks(0)   Quote Paolinho8cn93 Quote  Post ReplyReply Direct Link To This Post Posted: 04/Apr/2019 at 10:17
Ho dimenticato le immagini sarebbero in formato .jpg
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11938
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 04/Apr/2019 at 12:49
Ciao
la seguente macro inserisce nella cella Q7 (che sembra dall'immagine sottoposta una cella unita Q7:S10), una immagine adattandola a tale range.

Leggi attentamente la macro, che naturalmente dovrai inserire in un loop per tutte le immagini volute adattandola.

saluti

Sub Foto()
Application.ScreenUpdating = False
mPath = "C:\MieFoto" 'cartella con immagini

mFoto = "NomeFotoSenzaEstensione" ' es: Immagine1"

' OPPURE: mFoto= Range("A1") ' dove in A1 c'Ŕ scritto Immagine1


If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' se la foto esiste
    ' da quel che si vede nel tuo allegato, QUI TI DEVI POSIZIONARE IN Q7 _
      dove sembra ci siano celle unite Q7:S10
    Selection.UnMerge
    With ActiveSheet.Pictures.Insert(mPath & "\" & mFoto & ".jpg")
        .ShapeRange.LockAspectRatio = msoFalse
        mTop = ActiveCell.Top
        mLeft = ActiveCell.Left
        mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(3).Address).Height
        mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 2).Address).Width
        .Top = mTop
        .Left = mLeft
        .Width = mWidth
        .Height = mHeight
    End With
Else
    MsgBox "Foto inesistente"
End If
Application.ScreenUpdating = True
End Sub


Edited by dodo47 - 04/Apr/2019 at 12:55
domenico
win 10- office 2016
Back to Top
Paolinho8cn93 View Drop Down
Nuovo Utente
Nuovo Utente
Avatar

Joined: 03/Apr/2019
Location: Milano
Status: Offline
Points: 30
Post Options Post Options   Thanks (0) Thanks(0)   Quote Paolinho8cn93 Quote  Post ReplyReply Direct Link To This Post Posted: 05/Apr/2019 at 18:02
Ciao!
Grazie per la risposta.
Si le celle dove dovrebbero essere inserite le celle sono delle celle unite quindi ed Q7:S10...

Ho provato a scriverla in questo modo, ma ho naturalmente sbagliato qualcosa, mi puoi aiutare?

Sub Foto()
Application.ScreenUpdating = False
mPath = "C:\Users\ASUS\Desktop\Francia\EDF19\DATABASE GIOCATORI"
 mFoto= Range("Q12")
If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' se la foto esiste ' 
    Selection.Q7
    With ActiveSheet.Pictures.Insert(mPath & amp; "\" & mFoto & ".jpg")
        .ShapeRange.LockAspectRatio = msoFalse
        mTop = ActiveCell.Top
        mLeft = ActiveCell.Left
        mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(3).Address).Height
        mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 2).Address).Width
        .Top = mTop
        .Left = mLeft
        .Width = mWidth
        .Height = mHeight
    End With
Else
    MsgBox "Foto inesistente"
End If
Application.ScreenUpdating = True
End Sub[/code]


Non ho capito alcune cose:
1- If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' se la foto esiste ' 
    Selection.Q7
Se quando hai messo mPath e mFoto devo sostituirli con "C:\Users\ASUS\Desktop\Francia\EDF19\DATABASE GIOCATORI" e "Range("Q12")

2- With ActiveSheet.Pictures.Insert(mPath & amp; "\" & mFoto & ".jpg")
     Anche in questo caso non ho capito se devo sostituire mPatch e mFoto

Mi potresti ancora aiutare?
Grazie mille
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11938
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 06/Apr/2019 at 09:36
Ciao
1) If Dir(....... serve per sapere se la foto il cui  nome Ŕ (nel tuo caso) in Q12 esiste; quindi se non esiste segnala foto inesistente.
Non devi mettere altro, perchŔ la Path (la cartella che contiene le immagini) l'hai messa ed mFoto pure.

2) no, come prima giÓ ci sono nelle variabili impostate mPath e mFoto

Selection. unmerge lo devi lasciare, altrimenti la foto non viene adattata a Q7:S10

Pertanto:

.....
.....
If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' se la foto esiste
range(Q7).Select
    Selection.UnMerge
    With ActiveSheet.Pictures.Insert(mPath & "\" & mFoto & ".jpg")
.....
....

saluti



Edited by dodo47 - 06/Apr/2019 at 09:36
domenico
win 10- office 2016
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,078 seconds.