Salvare una foto in un'altra cartella, rinominarla ed importarla una Image su userform

Question

Buongiorno,

eccomi nuovamente con un altro problema che onestamente non riesco a capire dove è l'errore.

Avrei bisogno di una routine che mi permetta prendere una foto da qualsiasi parte del computer, rinominarla, ridurla di dimensioni e salvarla in una cartella specifica con un nome specifico.

Per fare tutto ciò ho trovato varie soluzioni online per i vari steps. Ho cercato di assemblare le varie opzioni per avere un codice finale che facesse al mio caso e sono riuscito nell'intento. Alle prime prove tutto ha funzionato perfettamente ma poi mi sono reso conto che come arrivo alla riga 38 del foglio il codice va in debug. Adesso è vero che non capisco niente di VBA ma non riesco proprio a capire perchè funziona per 38 righe e poi va in debug.

Quindi, come al solito, chiedo un aiuto a voi.

Di seguito il miocodice con la descrizione di ciò che vorrei fare. Forse è proprio il codice impostato male.

Dim shp As Shape

Dim cht As ChartObject

Dim strPath As String

Dim strfile As String

Dim DestD As String

Dim n As Integer, x As String

Dim img As String

Dim msg As String

Dim Nphoto As String

If Me.LB_Crew.ListIndex = -1 Then

msg = MsgBox("Crew member shall be selected to add a new photo", vbInformation, "READ INFORMATION")

Exit Sub

Else

DestD = ActiveWorkbook.Path & "\Matrix Pictures" & ActiveCell.Offset(0, 1) & ".jpg" <=== assegno la Path ed il nome ove salvare la foto

    With Application.FileDialog(msoFileDialogFilePicker) <====== Apro la cartella generale

        .Show

        If .SelectedItems.Count = 0 Then Exit Sub

        strfile = .SelectedItems(1) <=== seleziono una immagine

    End With

ActiveSheet.Pictures.Insert (strfile) <======== inserisco l'immagine sul foglio excel

  x = ActiveSheet.Shapes.Count

  For n = 1 To x

    Nphoto = ActiveSheet.Shapes(n).Name <======= trovo ll'immagine ed assegno il nome

Next

        Set shp = ActiveSheet.Shapes(Nphoto) <===== Assegno le nuove dimensioni all'immagine e la copio

        shp.Width = 100

        shp.Height = 100

        shp.CopyPicture xlScreen, xlPicture

        Set cht = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) <===Creo un ChartObject ed incollo la nuova immagine dimensionata

        cht.Chart.Paste

        cht.Border.LineStyle = 0

        cht.Chart.Export DestD <==== esporto la nuona immagine nella cartella scelta con il nome rucuperato dalla Listbox

        img = DestD        

        Me.foto.Picture = LoadPicture(img) <==== la carico sulla userform

        cht.Delete

        shp.Delete

Set shp = Nothing

Set cht = Nothing

End If

Me.LB_Crew.ListIndex = -1 <==== riporto la listindex al valore iniziale in modo da attivare il messaggio in caso non ci sia unapersona selezionata 

Adesso il punto è:

perchè fino alla riga 38 va tutto bene ed alla riga 39 va in debug sulla seguente riga?

cht.Chart.Paste

Anticipatamente ringrazio

Saluti

Giuseppe

Answer 1

Ciao Norman,

facendo centinaia di prove ho capito che il problema erano le coordinate del ChartObject.

Infatti lavorando con activecell.offset ed inserendo il ChartObject in "A1", appena scendevo di riga sul foglio mi dava l'errore di cui sopra.

Non so se ho fatto la procedura corretta ma ho risolto inserendo "range("A1").Select subito dopo aver assegnato l'offset alla variabile che mi serve per identificare il nome.

Facendo così anche se arrivo alla riga 200 del foglio excel il codice non va più in errore.

Grazie a tutti

Saluti

Giuseppe

Answer 2

Ciao Norman,

come detto all'inizio questo codice l'ho assemblato io prendendo vari esempi su internet.

Pertanto in uno di questi esempi c'era questa parte di codice:

strPath = ThisWorkbook.Path & Application.PathSeparatorFor Each Shape In ActiveSheet.Shapes    If Left(Cells(r, 1), 1) <> "#" Then        Set shp = ActiveSheet.Shapes(Shape.Name)        shp.CopyPicture xlScreen, xlPicture        Set cht = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height + 5)        cht.Chart.Paste

Se noti solo questa riga di codice :

Set shp = ActiveSheet.Shapes(Shape.Name)

il mio codice andava in errore perchè non trovava nessun nome. Per questo motivo ho inserito il ciclo che mi trova la shape e ne prende il nome.

Di seguito l'errore che mi da quando activecell.offset(0,1) si trova alla riga 38 del foglio excel.

Inoltre ho già controllato la sintassi del nome ed ho fatto varie prove. Funziona su tutte le righe del foglio excel dalla numero 1 alla numero 38 e poi dalla 38 in giù va sempre in debug.

questo è l'errore di debug

Questo è la parte di dove si interrompe.

Saluti

Giuseppe

Answer 3

Ciao Giuseppe,

grazie della risposta ma non mi è chiara.

Il Set cht = Nothing è alla fine dell'istruzione.

La riga cht.Chart.Paste è invece subito dopo  Set cht = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)

cioè a metà codice.

Forse hai pensato che l'ultime scritto da me fosse inserito nel codice?

L'ho scritto solo per far capire ove, una volta arrivato alla riga 38 del foglio excel, la routine va in debug mentre fino alla riga 37 del foglio excel tutto funziona correttamente.

Hai ragione: ho letto l'istruzione

cht.Chart.Paste

come l'istruzione finale del codice!

Di primo acchito, non vedo un problema con la riga citata del codice anche se non ho capito lo scopo del ciclo:

  For n = 1 To x

    Nphoto = ActiveSheet.Shapes(n).Name <======= trovo ll'immagine ed assegno il nome

Next

in quanto  mi pare che solo l'ultimo valore, ovvero il valore del nome dell'oggetto ActiveSheet.Shapes(x), sia utilizzato succesivamente.

Tuttavia penso che sarebbe utile sapere il testo completo dell'errore che riscontri e cosa sia diversa tra i valori di interesse sulle righe 37 e 38.

===

Regards,

Norman

Answer 4

Ciao Norman,

grazie della risposta ma non mi è chiara.

Il Set cht = Nothing è alla fine dell'istruzione.

La riga cht.Chart.Paste è invece subito dopo  Set cht = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)

cioè a metà codice.

Forse hai pensato che l'ultime scritto da me fosse inserito nel codice?

L'ho scritto solo per far capire ove, una volta arrivato alla riga 38 del foglio excel, la routine va in debug mentre fino alla riga 37 del foglio excel tutto funziona correttamente.

Grazie

Giuseppe

Answer 5

Ciao Giuseppe,

Credo  che l'istruzione

cht.Chart.Paste

sia impossibile da implementare in quanto in precedenza hai eseguito l'istruzione

Set cht = Nothing

per annullare l'oggetto cht.

Un oggetto inesistente non può essere incollato!

===

Regards,

Norman