SOSPENDERE ESECUZIONE CODICE

Hai un problema con Excel?

Nuova discussione

SOSPENDERE ESECUZIONE CODICE
di Riccardo57 (utente non iscritto) data: 09/04/2015 10:22:15
Buongiorno,
vorrei sapere se è possibile sospendere momentaneamente l'esecuzione del codice
Mi spiego meglio:
1) Tramite codice seleziono una serie di immagini (tabelle che devono essere stampate insieme ai dati di excel)
2) Inserisco la prima immagine nel foglio_1

3) A questo punto vorrei interrompere l'esecuzione del codice per selezionare (tranite mouse la larghezza delle colonne)

4) con la pressione di un tasto (per es invio) il codice dovrebbe proseguire per inserire le immagini successive e impostare le larghezze delle colonne uguali a quelle del foglio_1

Grazie
di Mister_x (utente non iscritto) data: 09/04/2015 12:15:27
ciao

( DoEvents )
vedi help per le spiegazioni e il suo utilizzo

ciao
di lepat (utente non iscritto) data: 09/04/2015 12:17:52
penso di possa fare utilizzando sempre lo stesso pulsante con cui avvii la macro e salvando la riga di inizio in una cella del foglio, ma sarebbe meglio disporre di un file di esempio

di rICCARDO57 (utente non iscritto) data: 09/04/2015 16:43:58
Mi potete aiutare ad inserire il codice per la funzione DoEvents e l'istruzione che intercetta la pressione del tasto invio?
Grazie

Di seguito il codice della macro

Sub LISTA_CATEGORIE()
'
' ***********************INSERISCE LE IMMAGINI DELLA LISTA DELLE CATEGORIE
'

IMMAGINE.Show


'SELEZIONA LA CARTELLA CON LE IMMAGINI

    percorsofile = Application.GetOpenFilename(FileFilter:="File immagini (*.bmp;*.jpg;*.tif),*.bmp; *.jpg; *.tif", Title:="Ricerca immagini", MultiSelect:=True)
    If percorsofile(1) = Falso Then GoTo FINE
    
    NomeImmagine_1 = percorsofile(1)
    cd = Split(NomeImmagine_1, "")
    NomeImmagine = cd(UBound(cd))
    PercorsoFile1 = Replace(percorsofile(1), NomeImmagine, "")
    NumeroImmagini = UBound(percorsofile)


'Imposta i margini della stampante a zero
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
    End With
    Application.PrintCommunication = True




'1° FOGLIO
ActiveSheet.Name = "01"
    Cells(1, 1).Select
    ActiveSheet.Pictures.Insert(NomeImmagine_1).Select
    With Selection
        .ShapeRange.ScaleHeight 1, msoTrue
        .ShapeRange.ScaleWidth 1, msoTrue
        .ShapeRange.PictureFormat.TransparentBackground = True
        .ShapeRange.PictureFormat.TransparencyColor = RGB(255, 255, 255)
    End With
    
LARGH_COLONNE.Show
    
'*********************************************************
'qui andrebbe inserito il codice DoEvents
'e l 'struzione per intercettare la pressione del tasto invio
'********************************************************
Dim colonna(1 To 10)
For col = 1 To 10
        colonna(col) = Columns(col).ColumnWidth
 Next col
    

'******************** FOGLI SUCCESSIVI ******************************
Application.ScreenUpdating = False
For x = 2 To NumeroImmagini
    NomeImmagine_1 = percorsofile(x)
    cd = Split(NomeImmagine_1, "")
    NomeImmagine = cd(UBound(cd))
    posizione = InStr(1, NomeImmagine, ".")
    NomeFoglio = Mid(NomeImmagine, 1, posizione - 1)
    PercorsoFile1 = Replace(percorsofile(x), NomeImmagine, "")
    
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = NomeFoglio
    
    Cells(1, 1).Select
    ActiveSheet.Pictures.Insert(NomeImmagine_1).Select
    With Selection
        .ShapeRange.ScaleHeight 1, msoTrue
        .ShapeRange.ScaleWidth 1, msoTrue
        .ShapeRange.PictureFormat.TransparentBackground = True
        .ShapeRange.PictureFormat.TransparencyColor = RGB(255, 255, 255)
    End With
For col = 1 To 10
    Cells(1, col).ColumnWidth = colonna(col)
Next col
    
Next x

FINE:
Application.ScreenUpdating = True
End Sub

Vuoi Approfondire?