Allora lascia il caricamento come era prima (copia dall' altro foglio) e aggiungi le istruzioni per ridimensionare:
- Codice: Seleziona tutto
Sheets("Parametri").Shapes("NODISPO").Copy
ActiveSheet.Paste
Selection.ShapeRange.Width = largo '<<<<
If Selection.ShapeRange.Height > altro Then Selection.ShapeRange.Height = alto '<<<<
(istruzioni marcate <<<)
2. Edit immagini
Per il risalvataggio con paint penso potrebbe essere fatto con questa macro:
- Codice: Seleziona tutto
Sub resave()
Dim myTim As Single, RetVal, WSShell
Dim myDir As String, myFile As String
'
myDir = "C:\Users\UTENTE\Downloads\byCOMMERCIALE_B40326_ZCZC\IMM_ORIG\" '<<< La Dir con le immagini
'
myFile = Dir(myDir & "*.jpg")
Do While myFile <> ""
'Debug.Print myFile
MyF = myDir & myFile
RetVal = Shell("C:\Windows\System32\mspaint.exe " & MyF, 1) '<<< Il percorso dell'applicativo mspaint
'
myTim = Timer
'Attesa attivazione mspaint:
Do
If IsProcessRunning("mspaint.exe") Or Timer > (myTim + 10) Or Timer < myTim Then Exit Do
DoEvents
Loop
'Debug.Print Timer
'ulteriore attesa 3 sec:
myTim = Timer
Do
DoEvents: DoEvents
If Timer > (myTim + 3) Or Timer < myTim Then Exit Do
Loop
Set WSShell = CreateObject("WScript.Shell")
'Debug.Print retVal
WSShell.SendKeys "%f", True '<< Vedi testo
WSShell.SendKeys "%s", True '<< Vedi testo
WSShell.SendKeys "{ENTER}", True '<< Vedi testo
'
DoEvents: DoEvents
WSShell.SendKeys "%{F4}", True '<< Vedi testo
'
myTim = Timer
'Attesa chiusura mspaint:
Do
If Not IsProcessRunning("mspaint.exe") Or Timer > (myTim + 10) Or Timer < myTim Then Exit Do
DoEvents
Loop
Set WSShell = Nothing
'File successivi:
nextF:
myFile = Dir
Loop
End Sub
Devi personalizzare le due istruzioni marcate <<<:
-per indicare la directory in cui si trovano le immagini (INSERIRE "\" IN CODA)
-per indicare il percorso dove, sul tuo pc, e' presente il file mspaint.exe
Prova prima con una decina di file, anche per valutare i tempi di esecuzione, che probabilmente saranno di 5-6 secondi per immagine (il codice e' semplificato, quindi si sciupa molto tempo per lanciare e chiudere mspaint).
La macro:
-cerca uno dopo l' altro i file ".jpg" presenti nella directory dichiarata
-apre quel file in mspaint
-lo salva, chiude mspaint, passa al file successivo.
Il salvataggio e' fatto inviando a mspaint la sequenza Alt-F-S-Enter; controlla che questa sequenza sia usata anche dal tuo mspaint; eventualmente sono da modificare le istruzioni WSShell.SendKeys (%f, %s, {ENTER}; %{F4} per chiudere il programma dovrebbe invece essere ok).
Nello stesso modulo in cui inserisci il codice della Sub resave metterai anche quest' altro, che serve a identificare quando mspaint e' pronto:
- Codice: Seleziona tutto
Private Function IsProcessRunning(ByVal ProcName As String) As Boolean
Dim objWMIService, objProcess, colProcess
Dim strComputer, strList
'
strComputer = "."
'
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process")
For Each objProcess In colProcess
If CBool(InStr(1, objProcess.Name, ProcName, vbTextCompare)) Then
IsProcessRunning = True
Exit Function
End If
DoEvents
Next
End Function
Ciao
Anthony io sono autodidatta e non capisco se devo solo toglierli o sostituirli...