faretesto > microsoft.* > microsoft.office.excel

draleo (12.01.2020, 12:13)
Salve. In un foglio Excel ci sono numerose immagini, allineate in righe e colonne (e numerate: 1,2,3, ecc). Vorrei ruotarle di 90° in senso antiorario, ma solo quelle la cui larghezza è > di 40 mm. Ne ho presa una acaso e l'ho ruotata manualmente. Il registratore mi da il seguente codice
ActiveSheet.Shapes.Range(Array("Immagine 43")).Select
Selection.ShapeRange.IncrementRotation 90
Come si fa ad applicarlo a tutte le immagini del foglio ?
Tra l'altro ho notato che l'operazione fatta manualmente, mi solleva l'immagine falsandone il suo allineamento con le altre (cosa che vorrei evitare).
draleo
buonocoreelio (12.01.2020, 15:28)
Il giorno domenica 12 gennaio 2020 11:13:08 UTC+1, draleo ha scritto:
> Salve. In un foglio Excel ci sono numerose immagini, allineate in righe ecolonne (e numerate: 1,2,3, ecc). Vorrei ruotarle di 90° in senso antiorario, ma solo quelle la cui larghezza è > di 40 mm. Ne ho presa unaa caso e l'ho ruotata manualmente. Il registratore mi da il seguente codice
> ActiveSheet.Shapes.Range(Array("Immagine 43")).Select
> Selection.ShapeRange.IncrementRotation 90
> Come si fa ad applicarlo a tutte le immagini del foglio ?
> Tra l'altro ho notato che l'operazione fatta manualmente, mi solleva l'immagine falsandone il suo allineamento con le altre (cosa che vorrei evitare).
> draleo


Prova con questa:

Sub test()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Width >= (40 / 25.4) * 72 Then
'Width in points; 1 point = 1/72 inch; 1 inch = 25,4 mm
sh.Select
Selection.ShapeRange.IncrementRotation -90
End If
Next sh
End Sub

Elio
draleo (12.01.2020, 16:34)
Il giorno domenica 12 gennaio 2020 14:28:29 UTC+1, buonoc...@gmail.com ha scritto:
[..]
> Next sh
> End Sub
> Elio


Grazie. Va molto bene. Per riallineare l'immagine alle altre,ho solo aggiunto
Selection.ShapeRange.IncrementTop -18.75
Un altro quesito: non credo sia possibile farlo , ma la butto là ugualmente (non escludo, anzi spero, che qualcuno di voi guru, possa riuscirci)
Se le immagini NON fossero sul foglio Excel, ma su una dir diversa (C:/prova)e chiamate 1.jpg,2.jpg....100.Jpg, si potrebbero ruotare allo stesso modoutilizzando il VBA (oppure in qualche altro modo)?
draleo
buonocoreelio (12.01.2020, 20:05)
Il giorno domenica 12 gennaio 2020 15:34:27 UTC+1, draleo ha scritto:
> Il giorno domenica 12 gennaio 2020 14:28:29 UTC+1, buonoc...@gmail.com hascritto:
> Grazie. Va molto bene. Per riallineare l'immagine alle altre,ho solo aggiunto
> Selection.ShapeRange.IncrementTop -18.75
> Un altro quesito: non credo sia possibile farlo , ma la butto là ugualmente (non escludo, anzi spero, che qualcuno di voi guru, possa riuscirci)
> Se le immagini NON fossero sul foglio Excel, ma su una dir diversa (C:/prova)e chiamate 1.jpg,2.jpg....100.Jpg, si potrebbero ruotare allo stesso modo utilizzando il VBA (oppure in qualche altro modo)?
> draleo


Probabilmente con API è possibile fare ciò ma in questo caso è possibile sfruttare IrfanView, un programma di grafica gratuito che ha un'interfaccia a linea di comando manipolabile attraverso VBA

Scarica IrfanView e prova la seguente macro che assume che l'installazione abbia il percorso di Default e che la versione scaricata sia la 64 bit; metti un'immagine di prova chiamata test.jpg in C: (NB ci deve essere uno spazio tra...i_view64.exe e c:\test...)

Option Explicit
Sub RuotaSinistraImmagineIrfanView()
Dim result
result = Shell("C:\Program Files\IrfanView\i_view64.exe
c:\test.jpg/rotate_l")

End Sub

Ciao
Elio
draleo (12.01.2020, 21:26)
Il giorno domenica 12 gennaio 2020 19:05:30 UTC+1, buonoc...@gmail.com ha scritto:
[..]
> End Sub
> Ciao
> Elio


Funziona. l'immagine viene ruotata correttamente. Non viene salvata ed occorre farlo manualmente. Ma come modificare la macro per applicare la rotazione a tutti file JPG della cartella che hanno una larghezza > di 40 mm ?
draleo
buonocoreelio (12.01.2020, 22:38)
Il giorno domenica 12 gennaio 2020 20:26:30 UTC+1, draleo ha scritto:
> Il giorno domenica 12 gennaio 2020 19:05:30 UTC+1, buonoc...@gmail.com hascritto:
> Funziona. l'immagine viene ruotata correttamente. Non viene salvata ed occorre farlo manualmente. Ma come modificare la macro per applicare la rotazione a tutti file JPG della cartella che hanno una larghezza > di 40 mm ?
> draleo


Devi consultare la guida in linea di IrfanView per capire le potenzialità.
Apri IrfanView premi F1 Espandi la voce Overview se già non è espansa e clicca su Command Line Options e trovi una serie di comandi tar lorocombinabili
per es la seguente macro ruota di 90° a sinistra tutte le immagini nella root C e ne salva una copia in un a cartella chiamata Immagini in C. L'applicazione IrfanView viene chiusa automaticamente alla fine dell'operazione. Nota che nella stringa ogni parametro è separato dagli altri da slash'/' da non confondere con back slash '\' che separa le cartelle all'interno dei percorsi.

Sub RuotaSinistraImmagineIrfanView()
Dim result
result = Shell("C:\Program Files\IrfanView\i_view64.exe c:\*.jpg/rotate_l/convert=C:\Immagini\*.jpg /killmesoftly")
End Sub

Non ho esplorato a sufficienza il programma per capire se riesce a selezionare da linea di comando le dimensioni delle immagini per operazioni selettive. Credo che però sia più semplice separare prima le immagini daconvertire (ruotare) da quelle da non convertire in un folder e poi procedere con la macro proposta. Sul web si trovano varie soluzioni per determinare i metadati di una immagine con vari linguaggi di programmazione.
Quindi: Divide et Impera.
buonocoreelio (13.01.2020, 03:34)
Il giorno domenica 12 gennaio 2020 21:38:30 UTC+1, buonoc...@gmail.com ha scritto:
> Il giorno domenica 12 gennaio 2020 20:26:30 UTC+1, draleo ha scritto:
> Devi consultare la guida in linea di IrfanView per capire le potenzialità.
> Apri IrfanView premi F1 Espandi la voce Overview se già non è espansa e clicca su Command Line Options e trovi una serie di comandi tar loro combinabili
> per es la seguente macro ruota di 90° a sinistra tutte le immagini nella root C e ne salva una copia in un a cartella chiamata Immagini in C. L'applicazione IrfanView viene chiusa automaticamente alla fine dell'operazione. Nota che nella stringa ogni parametro è separato dagli altri da slash'/' da non confondere con back slash '\' che separa le cartelle all'interno dei percorsi.
> Sub RuotaSinistraImmagineIrfanView()
> Dim result
> result = Shell("C:\Program Files\IrfanView\i_view64.exe c:\*.jpg/rotate_l /convert=C:\Immagini\*.jpg /killmesoftly")
> End Sub
> Non ho esplorato a sufficienza il programma per capire se riesce a selezionare da linea di comando le dimensioni delle immagini per operazioni selettive. Credo che però sia più semplice separare prima le immagini da convertire (ruotare) da quelle da non convertire in un folder e poi procedere con la macro proposta. Sul web si trovano varie soluzioni per determinare i metadati di una immagine con vari linguaggi di programmazione.
> Quindi: Divide et Impera.


In VBA tramite la 'shell application' è possibile navigare i files di un folder e di vedere i metadati; per le immagini è leggibile il metadato delle dimensioni in pixel.
In base al DPI desiderato è possibile derivare quale larghezza in pixel corrisponde a 40 mm.
Ho sviluppato questa routine che ruota tutte le immagini .jpg con larghezzasuperiore a 40 mm in una cartella chiamata Origine posta nella root principale di C: facendone la copia (quella ruotata) in una cartella chiamata DestinazioneImmagini in C. La lettura del metadato (larghezza in pixel), ritenuto adeguato al criterio, è il lavoro del VBA mentre il resto (rotazione e salvataggio) lo svolge IrvanView tramite i messaggi ricevuti tramite la linea di comando incapsulata nella funzione Shell.
N.B. il metadato è restituito come bstr e pertanto servono delle API per avere la corrispondente stringa in VBA. Ho testato il tutto solo su Excel 32bit perchè non ho avuto tempo per fare un codice con compilazionecondizionale che permette il funzionamento anche su Excel 64 bit.

Option Explicit
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVallpString As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Sub CovertiImamgini()
Dim arrHeaders(35)
Dim vPath ' da dichiarare come Variant
Dim objShell As Object
Dim objFolder As Object
Dim vValue
Dim sValue As String
Dim i As Long
Dim lWidth As Long
Dim lLarghezzaPixel As Long
Dim strFileName ' da dichiarare come Variant
Dim strDestinationFileName
Const DPI As Long = 72 '72 schermo '300 stampa
Const sLarghezza As Single = 4 'criterio larghezza in cm
Dim pointer As Long
Const DESTINATION_FOLDER As String = "c:\DestinazioneImmagini"
Select Case DPI
Case Is = 72
lLarghezzaPixel = 113
Case Is = 150
lLarghezzaPixel = 236
Case Is = 300
lLarghezzaPixel = 472
End Select
vPath = "C:\Origine\" '<< da cambiare con l'esatto nome della cartella
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(vPath)
For Each strFileName In objFolder.Items
For i = 0 To 34
If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni" Then
vValue = objFolder.GetDetailsOf(strFileName, i)
pointer = StrPtr(vValue)
sValue = StrFromPtr(pointer)
sValue = Replace(sValue, Chr(0), "")
sValue = Replace(sValue, Chr(42), "")
sValue = Replace(sValue, Chr(32), "")
lWidth = Val(sValue)
If lWidth > lLarghezzaPixel Then '<< Da cambiare
strDestinationFileName = strFileName 'Da cambiare se si vuole cambiare nome del file
Dim result
result = Shell("C:\Program Files\IrfanView\i_view64.exe " & vPath & strFileName & "/rotate_l /convert=" & DESTINATION_FOLDER & "\" & strDestinationFileName & "/killmesoftly")
End If

End If
Next i
Next
For Each strFileName In objFolder.Items
For i = 0 To 34
vValue = objFolder.GetDetailsOf(strFileName, 31)
'Debug.Print objFolder.GetDetailsOf(strFileName, i)
Next

Next
Set objFolder = Nothing
Set objShell = Nothing
End Sub

Public Function StrFromPtr(ByVal lpStr As Long) As String
Dim bStr() As Byte
Dim cChars As Long
On Error Resume Next
' Get the number of characters in the buffer
cChars = lstrlen(lpStr)
If cChars Then
' Resize the byte array
ReDim bStr(0 To cChars - 1) As Byte
' Grab the ANSI buffer
Call CopyMemory(bStr(0), ByVal lpStr, cChars)
End If
' Now convert to a VB Unicode string
StrFromPtr = StrConv(bStr, vbUnicode)
End Function
draleo (13.01.2020, 15:56)
Il giorno lunedì 13 gennaio 2020 02:34:04 UTC+1, buonoc...@gmail.com ha scritto:
[..]
> ' Now convert to a VB Unicode string
> StrFromPtr = StrConv(bStr, vbUnicode)
> End Function


L'ho provata con Ecel 64 bit e risoluzione schermo di 1366*768 (risoluzionedi default del mio PC). Per funzionare funziona, nel senso che non segnalaerrori e si vede che sta lavorando, ma alla fine ,nella cartella C:\DestinazioneImmagini non trovo alcuna immagine. Eppure nella cartella C:\origine ci sono delle immagini con larghezza > 40 mm. Ne ho considerata una come riferimento (9.JPG); Excel dice che misura mm 57*35 (quindi dovrebbe essere ruotata);in pixel risulta essere 217*133; DPI=96. Eppure non viene ruotata(o meglio non viene salvata nella cartella C:\DestinazioneImmagini)
Forse c'è qualche incongruenza tra mm, pixel,DPI, risoluzione schermo ? non c'ho mai capito un c... con questi diversi sistemi di misurazioni !
Grazie comunque per il tempo che mi dedichi
draleo
buonocoreelio (13.01.2020, 17:03)
Il giorno lunedì 13 gennaio 2020 14:56:12 UTC+1, draleo ha scritto:
> Il giorno lunedì 13 gennaio 2020 02:34:04 UTC+1, buonoc...@gmail.comha scritto:
> L'ho provata con Ecel 64 bit e risoluzione schermo di 1366*768 (risoluzione di default del mio PC). Per funzionare funziona, nel senso che non segnala errori e si vede che sta lavorando, ma alla fine ,nella cartella C:\DestinazioneImmagini non trovo alcuna immagine. Eppure nella cartella C:\origine ci sono delle immagini con larghezza > 40 mm. Ne ho considerata una come riferimento (9.JPG); Excel dice che misura mm 57*35 (quindi dovrebbe essereruotata);in pixel risulta essere 217*133; DPI=96. Eppure non viene ruotata (o meglio non viene salvata nella cartella C:\DestinazioneImmagini)
> Forse c'è qualche incongruenza tra mm, pixel,DPI, risoluzione schermo ? non c'ho mai capito un c... con questi diversi sistemi di misurazioni !
> Grazie comunque per il tempo che mi dedichi
> draleo


Mi pare strano che non ti dia errore di compilazione in Excel 64 bit. Le API proposte funzionano solo con Excel 32 bit. Prova a verificare nella finestra VBA se riesci a compilare il progetto: menu Debug >> compila VBAProject
Se non ti da errore; verifica se la macro capovolge tutte le immagini (indipendentemente dalla larghezza) sostituendo l'istruzione
If lWidth > lLarghezzaPixel Then

con
If lWidth > 0 Then

In ogni caso dammi riscontro del funzionamento o meno della macro
già proposta (vedi l'ultimo intervento del giorno 12 gennaio con relative note):

Sub RuotaSinistraImmagineIrfanView()
Dim result
result = Shell("C:\Program Files\IrfanView\i_view64.exe c:\*.jpg/rotate_l/convert=C:\Immagini\*.jpg /killmesoftly")
End Sub

Ciao

Elio
draleo (13.01.2020, 17:25)
> In ogni caso dammi riscontro del funzionamento o meno della macro
> già proposta (vedi l'ultimo intervento del giorno 12 gennaio con relative note):
> Sub RuotaSinistraImmagineIrfanView()
> Dim result
> result = Shell("C:\Program Files\IrfanView\i_view64.exe c:\*.jpg/rotate_l /convert=C:\Immagini\*.jpg /killmesoftly")
> End Sub


Questa Funziona: Tutte le immagini JPG di C vengono ruotate e salvate.

Invece, nella tua ultima macro, se sostituisco
If lWidth > lLarghezzaPixel Then
con
If lWidth > 0 Then
Non succede niente , nel senso che nessuna immagine viene salvata.
Comunque non mi segnala nessun errore di compilazione
draleo
buonocoreelio (13.01.2020, 19:20)
Il giorno lunedì 13 gennaio 2020 16:25:17 UTC+1, draleo ha scritto:
> Questa Funziona: Tutte le immagini JPG di C vengono ruotate e salvate.
> Invece, nella tua ultima macro, se sostituisco
> If lWidth > lLarghezzaPixel Then
> con
> If lWidth > 0 Then
> Non succede niente , nel senso che nessuna immagine viene salvata.
> Comunque non mi segnala nessun errore di compilazione
> draleo


Prova ad eseguire il codice passo - passo con F8 per capire cosa non va; inparticolare bisogna essere sicuri che siano stati scritti in italiano e che quindi esista un metadato 'Dimensioni'.

Intanto sottolineo che se non è complicato separare le immagini da convertire manualmente: 4 righe di codice sono state sufficienti.

Quindi il problema, volendo automatizzare il tutto, è solo la lettura dei metadati del file.
draleo (13.01.2020, 20:13)
Il giorno lunedì 13 gennaio 2020 18:20:07 UTC+1, buonoc...@gmail.com ha scritto:
> Il giorno lunedì 13 gennaio 2020 16:25:17 UTC+1, draleo ha scritto:
> Prova ad eseguire il codice passo - passo con F8 per capire cosa non va; in particolare bisogna essere sicuri che siano stati scritti in italiano e che quindi esista un metadato 'Dimensioni'.
> Intanto sottolineo che se non è complicato separare le immagini daconvertire manualmente: 4 righe di codice sono state sufficienti.
> Quindi il problema, volendo automatizzare il tutto, è solo la lettura dei metadati del file.


Si. Credo che il problema sia proprio il metadato Dimensioni. Eseguendo conF8 infatti quello che segue l'istruzione
If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni" Then

non viene mai eseguito. Ho provato con Size o Sizes ma non cambia nulla.
Per quanto riguarda il separare manualmente le immagini con larghezza> 40 mm, non è praticabile (possono essere 100ia di immagini ed è difficile-non impossibile- riconoscerle a vista). Comunque quando le immagini sono sul foglio Excel la tua prima procedura funzionava molto bene ed è quella che contava. Questa seconda era un accessorio utile , ma del quale posso farne anche a meno
Ciao
draleo
buonocoreelio (16.01.2020, 02:09)
Il giorno lunedì 13 gennaio 2020 19:13:04 UTC+1, draleo ha scritto:
> Il giorno lunedì 13 gennaio 2020 18:20:07 UTC+1, buonoc...@gmail.comha scritto:
> Si. Credo che il problema sia proprio il metadato Dimensioni. Eseguendo con F8 infatti quello che segue l'istruzione
> If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni" Then
> non viene mai eseguito. Ho provato con Size o Sizes ma non cambia nulla.
> Per quanto riguarda il separare manualmente le immagini con larghezza> 40mm, non è praticabile (possono essere 100ia di immagini ed è difficile-non impossibile- riconoscerle a vista). Comunque quando le immagini sono sul foglio Excel la tua prima procedura funzionava molto bene ed è quella che contava. Questa seconda era un accessorio utile , ma del quale posso farne anche a meno
> Ciao
> draleo


Sono curioso di sapere perchè non ti funziona; mi manderesti un tuo file di prova?
Grazie Elio
draleo (16.01.2020, 12:36)
Il giorno giovedì 16 gennaio 2020 01:09:23 UTC+1, buonoc...@gmail.com ha scritto:
> Il giorno lunedì 13 gennaio 2020 19:13:04 UTC+1, draleo ha scritto:
> Sono curioso di sapere perchè non ti funziona; mi manderesti un tuo file di prova?
> Grazie Elio


stasera te lo invio. comunque non funziona perchè' la condizione
If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni"
ecc ecc
end if
non si verifica mai e quindi le istruzioni contenute tra if e end if non vengono mai eseguite. deduco quindi che "Dimensioni" non viene mai trovata (almeno così credo)
Grazie
draleo
draleo (17.01.2020, 10:50)
Il giorno giovedì 16 gennaio 2020 11:36:23 UTC+1, draleo ha scritto:
> Il giorno giovedì 16 gennaio 2020 01:09:23 UTC+1, buonoc...@gmail.com ha scritto:
> stasera te lo invio. comunque non funziona perchè' la condizione
> If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni"
> ecc ecc
> end if
> non si verifica mai e quindi le istruzioni contenute tra if e end if non vengono mai eseguite. deduco quindi che "Dimensioni" non viene mai trovata (almeno così credo)
> Grazie
> draleo


Ieri non ho proprio trovato il tempo. Comunque, ripensandoci, può anche non servire in quanto si tratta di un semplice file Excel, senza alcun dato, in cui ho semplicemente fatto copia-incolla della tua macro senza alcuna modifica. C'è poi una cartella C:\Origine in cui ci sono varie immagini da ruotare e una cartella C:\DestinazioneImmagini (che è inizialmente vuota e rimane vuota anche dopo aver eseguito la macro). L'unica cosa che cambia è che in effetti il mio Excel è a 32 Bit (e non 64 comedichiarato). Avevo fatto confusione con il SO che è effettivamente 64bit. Quello che non capisco è l'istruzione
If objFolder.GetDetailsOf(objFolder.Items, i) = "Dimensioni"
Che è 'sta cosa chiamata "Dimensioni" che non viene trovata ?
draleo

Discussioni simili