Condividi:        

FILE PER INSERIMENTO AUTOMATICO DI 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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 02/04/14 23:40

1.Immagine NonDisp
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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Sponsor
 

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 03/04/14 18:03

1.Immagine NonDisp : FANTASTICO!! Funziona alla grande!
2. Edit immagini: Forse mi ero spiegato male... non intendevo risolvere questo problema con VBA...
In ogni caso ho provato ma causa antivirus (o altro) che interferisce spesso e volentieri con le VBA mi va in debug e devo continuamente cliccare su continua e quindi su centinaia di foto diventa poco pratico...
Comunque qualcosa di concreto mi ha fatto, domani valuto i risultati e ve li posto! grazie per ora!!!!
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 03/04/14 20:23

La macro "resave" non puo' essere seguita in debug mode (altrimenti i comandi vengono intercettati dallo stesso editor delle macro); va quindi lanciata da Excel ad esempio: Alt-F8, selezione resave dall' elenco macro, premi Esegui.
Io ho provato con una decina di immagini, a parte il tempo necessario per ogni immagine non ho avuto problemi.

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 04/04/14 08:09

Risultati Edit immagini riaperte con mspaint:
Immagini utilizzate nr. 5: Peso prima: 2048 kb; Peso dopo riapertura e salvataggio con paint: 1767 kb
Inserimento in Excel immagini prima: 2148 kb; Dopo la compressione automatica di Excel: 2146 kb
Inserimento in Excel immagini dopo riapertura e salvataggio con paint: 189 kb; Dopo la compressione automatica di Excel: 97 kb
Direi che la differenza è notevole....

Mi puoi spiegare come faccio a sapere se eseguo in debug mode o no? Ho spesso problemi che i comandi vengono intercettati e credevo fosse colpa dell'antivirus ma forse non è quello....
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 04/04/14 15:36

Direi che mspaint ripristina qualcosa nel formato delle immagini che prima le rendeva incomprimibili.

La macro "resave" deve essere eseguita tenendo (per sicurezza) chiusa la finestra dell' editor delle macro; se va in errore siamo "fritti"; pero' sapendo quele errore e su quale istruzione si puo' forse capire come rimediare...

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 05/04/14 07:31

La macro "resave" funziona e stanotte ha trasformato migliaia di immagini senza bloccarsi.
Diverso il problema che i comandi vengono intercettati (non solo con questa macro, mi succede spesso anche con altre), ho sempre pensato fosse colpa dell'antivirus ma forse non è così... In ogni caso ieri per le prime 10 volte non mi ha dato problemi l'utilizzo delle macro, poi ha cominciato ad andare in debug (non so il perché...); Ho riavviato il pc e da li ha ricominciato a funzionare bene per un'altra decina di volte poi ha ricominciato a farmi il debug... misteri della VBA Excel...

Per concludere il tutto mi manca il 3° punto del mio post iniziale:
3. Funzione esporta:
A volte va in errore e in loop, potete dare un’occhiata se ha dei problemi e di che tipo?


Vi scrivo di seguito tutto il modulo dove è inserito... se preferiti che vi alleghi il file fatemi sapere:

Codice: Seleziona tutto
Sub INSERISCE_TUTTE_LE_IMMAGINI()
'Crea le immagini come da lista presente nel range ListaF
ListaF = Sheets("Parametri").Range("B2").Value   '<<< Le celle con nome immagine
Application.GoTo (ActiveWorkbook.Sheets("IMMAGINI").Range("A1"))
For Each CELLA In Sheets("IMMAGINI").Range(ListaF)
    OldV = CELLA.Value
    CELLA.ClearContents: CELLA.Value = OldV
   
Next CELLA
End Sub

Sub CANCELLA_TUTTE_LE_IMMAGINI()
Cancel = Sheets("Parametri").Range("B6").Value   'Per decidere a quante colonne a destra cancellare
For Each pict In Sheets("IMMAGINI").Shapes
    If pict.TopLeftCell.Column = Cancel Then pict.Delete
    'pict.Delete 'SE VOGLIO CANCELLARE TUTTE LE IMMAGINI DAL FOGLIO METTERE APICE SU RIGA SOPRA E TOGLIERE DA PICT.DELETE
Next pict
End Sub

Sub INSERISCI_CARTELLA_IMMAGINI()
Application.GoTo (ActiveWorkbook.Sheets("Parametri").Range("B3"))
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.count = 0 Then
         MsgBox ("Nessuna voce selezionata, procedura annullata")
         GoTo Esci
         End If

    ActiveCell.Value = .SelectedItems.Item(1)
  End With
Esci:
End Sub

'Sub INSERISCI_IMMAGINE_NON_DISPONIBILE()                            'Se si decide di usare foto esterna
'Application.GoTo (ActiveWorkbook.Sheets("Parametri").Range("B4"))   'Se si decide di usare foto esterna
'  With Application.FileDialog(msoFileDialogFilePicker)              'Se si decide di usare foto esterna
'    .Show                                                           'Se si decide di usare foto esterna
'    If .SelectedItems.count = 0 Then                                'Se si decide di usare foto esterna
'    MsgBox ("Nessuna voce selezionata, procedura annullata")        'Se si decide di usare foto esterna
'    GoTo Esci                                                       'Se si decide di usare foto esterna
'    End If                                                          'Se si decide di usare foto esterna
'    ActiveCell.Value = .SelectedItems.Item(1)                       'Se si decide di usare foto esterna
'  End With                                                          'Se si decide di usare foto esterna
'Esci:                                                               'Se si decide di usare foto esterna
'End Sub                                                             'Se si decide di usare foto esterna

Sub DeleteAllVBACode()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
       
Set VBProj = ActiveWorkbook.VBProject
       
For Each VBComp In VBProj.VBComponents
    If VBComp.Type = vbext_ct_Document Then
        Set CodeMod = VBComp.CodeModule
        With CodeMod
          .DeleteLines 1, .CountOfLines
        End With

    Else
        VBProj.VBComponents.Remove VBComp
    End If
Next VBComp

End Sub

Sub removeAllCode()
    Dim awi 'activeWorkbookItem(index)
    Dim awcl As Integer 'activeWorkbook Component CountOfLines
    Dim count As Integer 'how many potential code modules
    Dim i As Integer 'loop counter
   
    On Error Resume Next

    count = ActiveWorkbook.VBProject.VBComponents.count

    For i = 1 To count
        Set awi = ActiveWorkbook.VBProject.VBComponents.Item(i)
        awcl = awi.CodeModule.CountOfLines
        awi.CodeModule.DeleteLines 1, awcl
    Next i
   
    Set awi = Nothing ' Release the object
End Sub



Sub ESPORTA()

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
TryAgain:
    With Application.FileDialog(msoFileDialogSaveAs)
        .Show
        Flname = .SelectedItems.Item(1)
    End With
    If Flname <> "" Then
        Set NewWkbk = Workbooks.Add
        ThisWorkbook.Sheets(2).Copy Before:=NewWkbk.Sheets(1)
        removeAllCode 'DeleteAllVBACode
        NewWkbk.SaveAs Flname
        If Err.Number = 1004 Then
            NewWkbk.Close
            MsgBox "File Name Not Valid" & vbCrLf & vbCrLf & "Try Again."
            GoTo TryAgain
        End If
        'ActiveWorkbook.Close
    End If

End Sub


Grazie ancora, siete fantastici!!
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 06/04/14 00:29

Scusa, mi rifiuto di debuggare una macro dove l' utente ha inserito On Error Resume Next.
Vorrei anche sapere perche' hai inserito Application.DisplayAlerts = False

Togli quelle istruzioni e procedi al test.

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 09/04/14 14:09

Mi sento un po' in imbarazzo... :-? Anthony io sono autodidatta e non capisco se devo solo toglierli o sostituirli...
Come prova li ho tolti, allego il file, rispetto a prima non rilevo differenze, mi va comunque in debug (ma potrebbe essere solo sul mio pc...).

File (400 KB total)
INSERIMENTO IMMAGINE DA FILE EXCEL versione 6.40.xls

Link di download
http://we.tl/X1swm3L51P


Siate pazienti...
Grazie ancora...
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 10/04/14 01:38

Quelle due istruzioni mascherano tutte le indicazioni di errore e di warning, lasciandoti alla fine con un risultato che, se e' sballato, non si sa da cosa dipende.
Vanno messe solo dove servono (ad esempio io metto On Error Resume Next prima di andare a cancellare una immagine che pero' potrebbe anche non esserci, ma ripristino la normale gestione dell' errore finita quella fase di cancellazione).
Ora dici che "ti va comunque in debug"; bene, dico io: su quale istruzione e con quale errore?

Quanto al fatto che "i comandi vengono intercettati" non so su quali elementi hai fatto tale diagnosi, ma se usi abitualmente On Error Resume Next puo' benissimo succedere che in fondo a una macro pochi comandi sono andati a buon fine e tutto il resto e' stato mangiato da un errore che la macro vuole ignorare (che e' il concetto di "On Error Resume Next").

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 10/04/14 07:26

Mi va in errore su questa istruzione

Flname = .SelectedItems.Item(1)

Grazie per il chiarimento!!
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 10/04/14 08:25

E con quale errore?
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 10/04/14 10:03

Se apro "Debug" mi evidenzia in giallo con la freccia quella riga.
Però se poi schiaccio "Continua" (F5) continua la Vba e credo che crei il file correttamente (cioè cancella sia il foglio che deve cancellare sia la vba inserita).
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 10/04/14 14:01

Ma quando hai la possibilita' di andare in "Debug" uscira' un messaggio, o no?
Comunque mi pare che il problema ce l' hai quando non fai nessuna selezione; per evitare cio' aggiungi un controllo che qualcosa sia stato selezionato:
Codice: Seleziona tutto
    With Application.FileDialog(msoFileDialogSaveAs)
        .Show
'IF AGGIUNTO >>>>>>
        If .SelectedItems.count = 0 Then
             MsgBox ("Nessuna voce selezionata, procedura annullata")
             Exit Sub
        End If
        Flname = .SelectedItems.Item(1)
    End With

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 11/04/14 09:39

Il messaggio è " Esecuzione del codice interrotta"
Dopo provo il tuo suggerimento
Grazie
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 11/04/14 10:02

Mi da ancora " Esecuzione del codice interrotta"..
Se apro "Debug" mi indica l'errore proprio nella riga appena inserita: If .SelectedItems.count = 0 Then 'aggiunto 11/4/2014

Se qualcuno riesce a provare dal file originale poi mi sa dire se l'errore è solo sul mio pc o cosa...

File (400 KB total)
INSERIMENTO IMMAGINE DA FILE EXCEL versione 6.40.xls
Disponibile fino a 18 Aprile 2014
Link di download
http://we.tl/s2O9UkVwIE


Grazie ancora
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 11/04/14 13:33

"Esecuzione del codice interrotta"
Mumble mumble... quel messaggio esce quando si preme Contr-Interruz...
Prova con questa sequenza: lancia la macro; senza scegliere nessuna directory premi Contr-Interruz; la macro dovrebbe fermarsi forse con lo stesso messaggio (conferma o smentisci); termina la macro premendo Fine.
Poi prova a rieseguire piu' volte.
Sul mio Pc non ho (mai avuto) il problema, dopo un venti-trenta cicli di esecuzione.

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 23/04/14 14:36

Buongiorno,
Mi son dimenticato di scrivervi... con il metodo suggerito il problema si è risolto, almeno momentaneamente, nel senso che 2 giorni dopo, quando ho riutilizzato il file, mi dava ancora " Esecuzione del codice interrotta"

Ho provato su un altro computer e il problema non c'è stato, e visto che anche Anthony non ha mai avuto il problema, persisto nell'idea che è un'interferenza locale (antivirus? Firewall?).

Grazie mille... e alla prossima!!
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi Anthony47 » 23/04/14 15:00

Ancora una prova, da eseguire con molta cautela...
In testa alla tua macro inserisci l' istruzione
Codice: Seleziona tutto
Application.EnableCancelKey = xlDisabled


Poi fai un paio di prove ("un paio" e' da rapportare alla frequenza con cui ti capita l' errore).
La cautela e' suggerita dal fatto che in quel modo la macro non puo' essere terminata con la sequenza Contr-Interr, quindi in caso di blocco della macro devi interrompere Excel da TaskManager.

Altra prova da fare e' ripristinare l' ambiente Office sul tuo pc, seguendo le istruzioni di questo articolo Microsoft: http://office.microsoft.com/it-it/excel ... 57402.aspx

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

Re: FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI

Postdi commerciale » 24/04/14 17:33

Provati entrambi, il primo non sembra avere effetto, il secondo ha funzionato giusto per 2 prove dopo il riavvio del pc, alla 3 dava ancora errore.
Ricordo che questo problema l'avevo anche con il precedente pc sempre in rete....
Comunque grazie mille Anthony, non ti disturbare oltre!!
Alla prossima!!
commerciale
Utente Junior
 
Post: 92
Iscritto il: 16/07/11 09:14

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "FILE PER INSERIMENTO AUTOMATICO DI IMMAGINI":


Chi c’è in linea

Visitano il forum: Nessuno e 36 ospiti