Metter in attesa una routine

Hai un problema con Excel?

Nuova discussione

Metter in attesa una routine
di Riccardo57 data: 06/03/2009
E' possibile metter in attesa una routine, per selezionare una cella, che cambia di volta in volta, dalla quale leggere il valore di una variabile?

grazie per l'eventuale risposta
di Ricky53 data: 07/03/2009
Ciao,
benvenuto nel forum.

perchè vuoi fermare per far scrivere in una cella un valore da associare ad una variabile, non puoi utilizzare "inputbox" ed avere così la variabile inpostata?

c'è qualche altra cosa che non hai scritto??

spesso quando viene inserito un quesito si semplifica e vengono omesse informazioni importanti che si scoprono quando c'è un intevento di chi non ha capito e chiede spiegazioni.

ciao da ricky53

Fermare routine
di Riccardo57 (utente non iscritto) data: 09/03/2009
Ho una routine che che crea una serie di nuovi fogli, partendo da un folgio base, leggendo i valori (nomefoglio)dalla colonna b del foglio prezzi, scendendo di una riga dopo ogni lettura e creazione del foglio.
per fare questo devo prima posizionarmi sul foglio prezzi, nella posizione (cella) esatta da cui far partire la lettura.
vorrei invece poter selezionare la cella da cui far partire la lettura, anche dopo che la routine sia iniziata, in risposta ad un msgbox che mi chieda "posizionati sul folgio e sulla cella di inizio".
sarebbe molto più flessibile e non darebbe errore in caso mi sia dimenticato di posizionarmi esattamente prima di iniziare la routine.

allego il codice della routine in questione (mi vergogno un po' per quanto è grezzo, ma funziona)

grazie riccardo57

Dim strNom As String
    Dim strFog As String
    Dim NOMEFOGLIO As String
    Dim Counter
    Dim i As Integer
    Dim Sh As Worksheet
    Dim MonNom As String
    Dim BonNom As Boolean
    Dim LeString
    
    
Sub ANALISI()
'
'Definisce i caratteri non validi
LeString = ":/?*[] " '
'
' Scelta rapida da tastiera: CTRL+w
'
 
'
Application.Calculation = xlManual

'definisce le finestre
NOMEFILE = ActiveWorkbook.Name
NOMEFINESTRA1 = NOMEFILE & ":1"
NOMEFINESTRA2 = NOMEFILE & ":2"
NOMEFINESTRA3 = NOMEFILE & ":3"

'Seleziona il folgio prezzi nella finestra 2
ActiveWorkbook.Windows(NOMEFINESTRA2).Activate
Sheets("PREZZI").Select

FOGLIO_RIFERIMENTO = InputBox("NOME DEL FOGLIO DA COPIARE")
If FOGLIO_RIFERIMENTO = "" Then
    GoTo FINE
    Else: GoTo PROSEGUI

PROSEGUI:
    'definisce la posizione dl codice art - n° scheda - prezzo di analisi
    Sheets(FOGLIO_RIFERIMENTO).Select
    CODICE_ART = Range("B2").Value
    NUMERO_Scheda = Range("C2").Value
    PREZZO_DI_ANALISI = Range("D2").Value

    Sheets("PREZZI").Select
    Counter = InputBox("Numero totale righe da analizzare POSIZIONARSI CON IL CURSORE SUL CODICE PREZZO")
    ActiveCell.Select

    ' Loop fino all'esaurimento dei delle schede previste
    For i = 1 To Counter

        'POSIZIONARSI CON IL CURSORE SUL CODICE PREZZO
        Sheets("PREZZI").Select
        NOMEFOGLIO = ActiveCell.Value
        strFog = ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Value
        
            
            'VERIFICHE SUL NOME DEL FOGLIO
            Do
                BonNom = True
                If NOMEFOGLIO <> "" Then
                'verifica se il nome non esiste...
                    For A = 1 To ActiveWorkbook.Worksheets.Count
                        If UCase(NOMEFOGLIO) = UCase(Worksheets(A).Name) Then
                            supp = MsgBox( _
                                 "Un foglio con questo nome è già presente," _
                                + vbCrLf + vbCrLf + _
                                "volete sostituirlo ?.", vbYesNo + vbOKOnly, _
                                "Nome già usato")
                                If supp = vbYes Then
                                    Application.DisplayAlerts = False
                                    Worksheets(NOMEFOGLIO).Delete
                                    Application.DisplayAlerts = True
                                    Exit For
                                Else
                                    BonNom = False
                                    NOMEFOGLIO = InputBox("Qual è il nome per" _
                                        + vbCrLf + "il foglio ?", _
                                        "dare nome ", MonNom)
                                    MonNom = NOMEFOGLIO
                                    Exit For
                                End If
                        End If
                    Next
    
                'verifica che il nome non fa più di 31 caratteri...
                    If Len(NOMEFOGLIO) > 31 Then
                        MsgBox "Il numero di carattere (" & _
                            Len(NOMEFOGLIO) & ") del nome è troppo grande" _
                            + vbCrLf + " il massimo è (31) per excel.", _
                            vbCritical + vbInformation, "Nome troppo longo"
                        BonNom = False
                        MonNom = NOMEFOGLIO
                    End If
            
            'verifica se nel nome non ci sono caratteri vietati...
VERIFICA3:
                NOMEFOGLIO = Replace(NOMEFOGLIO, "  ", " ")
                NOMEFOGLIO = Replace(NOMEFOGLIO, " ", ".")
                NOMEFOGLIO = Replace(NOMEFOGLIO, "/", ".")
                NOMEFOGLIO = Replace(NOMEFOGLIO, "-", ".")
                NOMEFOGLIO = Replace(NOMEFOGLIO, ":", ".")
                NOMEFOGLIO = Replace(NOMEFOGLIO, "*", ".")
                NOMEFOGLIO = Replace(NOMEFOGLIO, "?", ".")

                Else
                    Exit Sub
                End If
            Loop Until BonNom = True

    
    'Windows("DIM.xlsb:1").Activate
    Sheets(FOGLIO_RIFERIMENTO).Copy Before:=Sheets(FOGLIO_RIFERIMENTO)


'
    ActiveSheet.Name = NOMEFOGLIO
    Sheets(NOMEFOGLIO).Select
    
    ' COLORA LA SCHEDA DI ARANCIONE
    ActiveWorkbook.Sheets(NOMEFOGLIO).Tab.ColorIndex = 45
    
    Range(CODICE_ART).Select
    ActiveCell.FormulaR1C1 = NOMEFOGLIO
        
    Range(NUMERO_Scheda).Select
    ActiveCell.FormulaR1C1 = strFog
    strNom = "_sh" & strFog

    
    
    STRTMP = "=" & NOMEFOGLIO & "!" & Worksheets(NOMEFOGLIO).Range(NUMERO_Scheda).Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.Names.Add Name:=strNom, RefersToR1C1:=STRTMP

    Range(PREZZO_DI_ANALISI).Select
    strNom = "_" & Range(CODICE_ART).Value
    
    STRTMP = "=" & NOMEFOGLIO & "!" & Worksheets(NOMEFOGLIO).Range(PREZZO_DI_ANALISI).Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.Names.Add Name:=strNom, RefersToR1C1:=STRTMP

    


Counter = Counter - 1
            ' Selects the next cell.
    'Windows("DIM.xlsb:2").Activate
    Sheets("PREZZI").Select
    ActiveCell.Offset(1, 0).Select
    
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayZeros = False
    End With


Next i



    Application.Calculation = xlAutomatic
    Application.Goto Reference:=strNom

End If
FINE:
End Sub

di R (utente non iscritto) data: 09/03/2009
Guarda la guida in linea a proposito di application.inputbox ti permette di avere una inputbox e gestire la selezione di un range ... anzichè avere una msgbox che ti chieda di selezionare e mettere la routine in attesa (operazione non certo consigliabile) puoi avere una inputbox che accetta solo input di selezione di range e gestire tale selezione nelle righe successive del codice ...
fai sapere
saluti
r

di R (utente non iscritto) data: 09/03/2009
A titolo di esempio ...
saluti
r


Sub prova()

Dim rng As Excel.Range
On Error Resume Next
Set rng = Application.InputBox("seleziona la cella da cui partire", , , , , , , 8)

If Err Then
    Exit Sub
Else
    If rng.Count = 1 Then
        'ok è stata selezionata una cella singola
        MsgBox "il valore della cella selezionata è " & rng.Value
    Else
        MsgBox "hai selezionato più di una cella"
    End If
End If

On Error GoTo 0
End Sub

di Riccardo57 (utente non iscritto) data: 09/03/2009
E' perfetta grazie mille

di R (utente non iscritto) data: 09/03/2009
Potresti anche verificare che il range selezionato sia interno al tuo range ...
saluti
r

Sub prova()

Dim rng As Excel.Range
Dim TuoRng As Excel.Range
On Error Resume Next
Set rng = Application.InputBox("seleziona la cella da cui partire", , , , , , , 8)
Set TuoRng = [a1:a10]'<< da cambiare 
If Err Then
    Exit Sub
Else
    If rng.Count = 1 Then
        If Intersect(rng, TuoRng) Is Nothing Then
            MsgBox "la cella selezionata non è interna al tuo range"
        Else
            'ok è stata selezionata una cella singola
            MsgBox "il valore della cella selezionata è " & rng.value
        End If
    Else
        MsgBox "hai selezionato più di una cella"
    End If
End If

On Error GoTo 0
End Sub

Vuoi Approfondire?