Condividi:        

Cotrollo dimensioni immagini

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Cotrollo dimensioni immagini

Postdi nicola_na78 » 20/11/16 16:09

Salve a tutti, mi dite se è possibile fare con una macro excel la seguente cosa: vorrei che controllando tutte le immagini presenti nella cartella "Immagini" nella colonna "A" mi restituisca il nome dell'immagine e nella colonna "B" la dimensione.
Es. rigo 1: immagine1.jpg 800x800pixel


Grazie, buona domenica
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Sponsor
 

Re: Cotrollo dimensioni immagini

Postdi alfrimpa » 20/11/16 17:14

Codice: Seleziona tutto
Ciao Nicola

Inserisci questa macro in un modulo standard

Codice: Seleziona tutto
Sub prova()
Dim strFile As String
    Dim stdPic As StdPicture
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim strPath As String
    Dim intRow As Integer
    strPath = "c:\prova" '<==== Modifica con tua directoy
    strFile = Dir$(strPath & "\*.jpg") '
    Do While Len(strFile)
        Set stdPic = LoadPicture(strPath & "\" & strFile)
        intRow = intRow + 1
        Range("A" & intRow).Value = strFile
        Range("B" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("C" & intRow).Value = Round(stdPic.Height / 26.4583)
        strFile = Dir$
    Loop
End Sub
Alfredo

Win7 + Office 2007
Avatar utente
alfrimpa
Utente Senior
 
Post: 1201
Iscritto il: 30/12/13 17:01
Località: Napoli

Re: Cotrollo dimensioni immagini

Postdi alfrimpa » 20/11/16 17:42

Io ho supposto che tutte le immagini abbiano estensione ".jpg".

Se così non è la macro va modificata.
Alfredo

Win7 + Office 2007
Avatar utente
alfrimpa
Utente Senior
 
Post: 1201
Iscritto il: 30/12/13 17:01
Località: Napoli

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 21/11/16 17:41

Ciao Alfredo,

siccome interessa anche a me, mi potresti dire come modificheresti la macro se volessi controllare tutti i formati?

Grazie
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi alfrimpa » 21/11/16 20:43

Credo sia sufficiente modificare questa istruzione

Codice: Seleziona tutto
strFile = Dir$(strPath & "\*.jpg")


in

Codice: Seleziona tutto
strFile = Dir$(strPath & "\*.*")


Ovviamente nella directory ci devono essere solo file immagine.
Alfredo

Win7 + Office 2007
Avatar utente
alfrimpa
Utente Senior
 
Post: 1201
Iscritto il: 30/12/13 17:01
Località: Napoli

Re: Cotrollo dimensioni immagini

Postdi nicola_na78 » 21/11/16 21:40

Grazie Alfredo... Provo subito la macro.... Buona serata
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 22/11/16 01:08

Ciao, grazie molte, e se ci fossero anche altri files? C'è modo semplice per estrarre solo il nome delle immagini nei formati "più comuni"?

Grazie a chiunque darà risposta

Ciao a tutti
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi Anthony47 » 22/11/16 02:00

Modifica come segue:
Codice: Seleziona tutto
strPath = "c:\prova" '<==== Modifica con tua directoy
allpics = Array("*.jpg", "*.png", "*.gif")   '<<< Altri formati?       '***
For Each itm In allpics                                                '***
    strFile = Dir$(strPath & "\" & itm) '                              '***
    Do While Len(strFile)
        Set stdPic = LoadPicture(strPath & "\" & strFile)
        intRow = intRow + 1
        Range("A" & intRow).Value = strFile
        Range("B" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("C" & intRow).Value = Round(stdPic.Height / 26.4583)
        strFile = Dir$
    Loop
Next itm                                                              '***

Le parti aggiunte o modificate sono marcate ***

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 22/11/16 08:49

Grazie Anthony!

a presto, ciao.
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 22/11/16 14:04

Ciao a tutti, provo ad alzare un po' (tanto) la posta.

se non volessi limitarmi alla sola cartella, ma anche a tutte le sotto cartelle e ad eventuali sotto-...-sotto-cartelle?

In sostanza: è possibile elencare tutte le immagini del mio hard disk (con relative dimensioni e peso in kb) in un colpo solo senza modificare il percorso? Mi sembra infattibile ma sarebbe fantastico.

Grazie e ciao.
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi cromagno » 23/11/16 03:36

recalcatiiti ha scritto:Ciao a tutti, provo ad alzare un po' (tanto) la posta.

se non volessi limitarmi alla sola cartella, ma anche a tutte le sotto cartelle e ad eventuali sotto-...-sotto-cartelle?

In sostanza: è possibile elencare tutte le immagini del mio hard disk (con relative dimensioni e peso in kb) in un colpo solo senza modificare il percorso? Mi sembra infattibile ma sarebbe fantastico.

Grazie e ciao.


Ciao a tutti,
@recaltiiti
tu hai provato qualcosa?

Dopo la tua ultima domanda su Eulero mi aspetto qualche tua iniziativa Immagine
Windows 10 + Office 2013 64bit(ita)
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Avatar utente
cromagno
Utente Junior
 
Post: 66
Iscritto il: 08/10/16 16:33
Località: Sardegna

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 23/11/16 10:13

Ciao cromagno,

francamente non ne ho la più pallida idea.
Tu invece? Che sei un vero asso con il linguaggio, ne hai qualcuna? :)

Ciao e a presto
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi Anthony47 » 23/11/16 18:22

Scusate se mi intrometto :D :D
Non ho tempo per elaborare una "soluzione", pero' vi lascio il componente che dovrebbe risolvere, e cioe' questa Funzione che dovrebbe popolare la matrice di tutti i file "immagine" presente nella directory di partenza e tutte le sue subdir. Il codice, da inserire in testa al modulo vba che contiene la Sub prova:
Codice: Seleziona tutto
Dim myFso As Object, ccAll As Long    'RIGOROSAMENTE IN TESTA AL MODULO
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        myind = UBound(cStore)
        ReDim Preserve cStore(1 To myind + 1)
        cStore(myind) = myItm
    End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function

La function va richiamata all'inizio della Sub prova, con queste istruzioni:
Codice: Seleziona tutto
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("jpg", "png", "gif")    '<<< Altri formati?       '***
StrDir=" C:\PERCORSO\Documents"         '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)

La RecurDir compilera' la matrice FArr con tutti i files che hanno una extension pari a quelle dichiarate in "allpics".
Il restante codice della Sub prova dovra' lavorare uno per uno sui file contenuti in FArr; dovrebbe essere sufficiente qualcosa come
Codice: Seleziona tutto
For I=1 to ubound(FArr)
    If len(fArr(i)>0 then
'qui le istruzioni prima inserite nel Do While /Loop
    End If
Next I

Attenzione, che scandire tutto il disco potrebbe richiedere "il suo tempo", quindi meglio partire con una directory dal contenuto modesto

Provate, e se vi arenate spiegate dove e come...
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 24/11/16 10:28

Tu non ti intrometti mai e grazie per la risposta.

Bah... Io ci provo, sicuramente c'è qualche errore banale che non vedo date le mie scarse conoscenze.

Seguendo le tue indicazioni ( e abbandonandomi all'interpretazione spregiudicata :undecided: :lol: ) è uscita questa cosa:

Codice: Seleziona tutto
Dim myFso As Object, ccAll As Long    'RIGOROSAMENTE IN TESTA AL MODULO
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        myind = UBound(cStore)
        ReDim Preserve cStore(1 To myind + 1)
        cStore(myind) = myItm
    End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function
Sub prova()
Dim strFile As String
    Dim stdPic As StdPicture
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim strPath As String
    Dim intRow As Integer
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("jpg", "png", "gif")    '<<< Altri formati?       '***
StrDir = "c:\prova"       '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)
For Each itm In allpics                                                '***
    strFile = Dir$(strPath & "\" & itm) '                              '***
   For i = 1 To UBound(FArr)
    If Len(FArr(i)) > 0 Then
Set stdPic = LoadPicture(strPath & "\" & strFile) '<--------------------
        intRow = intRow + 1
        Range("A" & intRow).Value = strFile
        Range("B" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("C" & intRow).Value = Round(stdPic.Height / 26.4583)
        strFile = Dir$
    End If
Next i
Next itm
End Sub


che va in debug alla riga contrassegnata con '<-------------------- riportando l'errore: run-time 76 impossibile trovare il percorso.

Chiaramente in fase di test ho inserito un percorso valido ed esistente.

Aspetto cromagno con la sua interpretazione e aspetto trepidante la tua Anthony :lol:

Ciao, grazie e a presto.
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi Anthony47 » 24/11/16 15:34

Eh, tutto bene fino a "End Function", poi....

Ecco una versione piu' canonica e con in piu' una fase di gestione di eventuali errori in fase di LoadPicture; nelle mie prove infatti mi son trovato con delle immagini che davano errore
Codice: Seleziona tutto
Sub prova()
Dim strFile As String
    Dim stdPic As StdPicture
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim strPath As String
    Dim intRow As Integer
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("jpg", "png", "gif")    '<<< Altri formati?       '***
StrDir = "c:\prova"       '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)
For i = 1 To UBound(FArr)
    If Len(FArr(i)) > 0 Then
        intRow = intRow + 1
        Range("A" & intRow).Value = FArr(i)
On Error GoTo piPP
        Set stdPic = LoadPicture(FArr(i)) '<--------------------
        Range("B" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("C" & intRow).Value = Round(stdPic.Height / 26.4583)
'        strFile = Dir$
piPP:
Resume poPP
poPP:
    End If
Next i
End Sub

Pero' se si tratta di immagini prodotte da camere prodotte negli ultimi 10 anni le stesse informazioni dovrebbero essere leggibili nelle proprieta' del file, ma oggi non avro' altro tempo per indagare.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 24/11/16 17:36

Eh, tutto bene fino a "End Function", poi....

:lol: :lol: :lol:

Ormai è scontato dire che funzioni alla perfezione.

Se volessi ottenere il percorso in una cella e il nome dell'immagine in un altra, come posso fare? ho smanettato un po' ma non ne vengo a capo... Vorrei anche visualizzare la dimensione del file, ho appreso che si può usare
Codice: Seleziona tutto
FileLen( file_path )
ma non riesco ad integrarlo...

Grazie e ciao.
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi Anthony47 » 24/11/16 18:41

Sarebbe stato meglio farlo sentro la RecurDir, ma non ho tempo per cmbiare la sua struttura dati. Prova con
Codice: Seleziona tutto
Sub prova()
Dim strFile As String
    Dim stdPic As StdPicture
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim strPath As String
    Dim intRow As Integer
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("jpg", "png", "gif")    '<<< Altri formati?       '***
StrDir = "c:\prova"       '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)
For i = 1 To UBound(FArr)
    If Len(FArr(i)) > 0 Then
        intRow = intRow + 1
        mysplit = Split(FArr(i), "\", , vbTextCompare)
        If UBound(mysplit) > 0 Then Range("B" & intRow).Value = mysplit(UBound(mysplit))
        Range("A" & intRow).Value = Replace(FArr(i), "\" & mysplit(UBound(mysplit)), "\", , , vbTextCompare)
        Range("E" & intRow).Value = myFso.getfile(FArr(i)).Size
On Error GoTo piPP
        Set stdPic = LoadPicture(FArr(i)) '<--------------------
        Range("C" & intRow).Value = Round(stdPic.Width / 26.4583)
        Range("D" & intRow).Value = Round(stdPic.Height / 26.4583)
       
'        strFile = Dir$
piPP:
Resume poPP
poPP:
    End If
Next i
On Error Resume Next
Set myFso = Nothing
On Error GoTo 0
End Sub
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 25/11/16 14:17

Grazie Anthony, funziona alla perfezione.

Ultima speculazione, prometto. E' possibile eliminare dei file tramite vba? ad esempio, è possibile eliminare le immagini che negli anni, per diversi motivi, ho duplicato e che ora compaiono anche in diverse copie nel mio disco?

Grazie e ciao.
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Re: Cotrollo dimensioni immagini

Postdi Anthony47 » 27/11/16 03:07

Se vuoi ti faccio una macro che cancella un file se nell'elenco ne compare un altro avente stesso nome e stesse dimensioni di file; pero' prima della cancellazione di ogni file, per sicurezza, ne farei due copie di backup su due directory diverse :diavolo:

Ti sembra valido??
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cotrollo dimensioni immagini

Postdi recalcatiiti » 28/11/16 08:43

Ciao Anthony, la validità del messaggio precedente non si può neanche quantificare.

Quindi se non è di grande disturbo, e hai tempo e voglia, mi piacerebbe molto.

C'è una piccola questione però... La macro precedente elenca perfettamente tutte le immagini di directory (anche abbastanza grandi), ma se estendo la "ricerca" a tutto il disco C, neanche dopo 38 h, riesce a creare l'elenco... Come mai?

Grazie mille e a presto, ciao!
Excel 2021
recalcatiiti
Utente Junior
 
Post: 95
Iscritto il: 12/10/15 15:03

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Cotrollo dimensioni immagini":


Chi c’è in linea

Visitano il forum: Marius44 e 37 ospiti