Message box condizionata

Hai un problema con Excel?

Nuova discussione

Message box condizionata
di ffante (utente non iscritto) data: 26/04/2014 11:55:58
Non conosco bene il vba vi chiedo se è possibile avere una message box condizionata.

Devo controllare gli inserimenti sulla cella "E5" del foglio (Home)

Se la cella contiene i dati mi deve restituire il 1° message box

Se la cella non contiene i dati mi deve restituire il 2° message box.

Se mi potete aiutare

di Textomb data: 26/04/2014 12:53:50
ti potrebbe bastare controllare l'evento change della selezione nel foglio Home.
controlli se ti trovi sulla cella E5 e, nel caso, fai partire il messaggio condizionato.
Insomma una cosa del genere.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Msg1 As String, Msg2 As String
Msg1 = "La cella E5 contiene dati"
Msg2 = "La cella E5 non è valorizzata"

    If Target.Address = "$E$5" Then
        If Not IsEmpty([e5]) Then MsgBox Msg1 Else MsgBox Msg2
    End If

End Sub

Message box condizionata
di ffante (utente non iscritto) data: 26/04/2014 14:08:33
Questo codice lo dovrei inserire all'interno del codice sottostante.

l'ho provato mi si blocca.

Sub Inserisci_Trattamento_Click()

'   Macro
 
    Application.ScreenUpdating = False

    Sheets("Database").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    Sheets("Home").Select
    Range("E5").Select
    Selection.Copy
    Sheets("Database").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("H5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C2").Select
    Sheets("Database").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("H7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("E2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Home").Select
    Range("H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("F2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("G2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("H11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("H2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("I2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("H13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("J2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("K2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("H15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("L2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Home").Select
    Range("E17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("M2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Home").Select
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("N2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Home").Select
    Range("E19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Database").Select
    Range("O2").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'Elimina_Righe_Vuote
    
    Dim Intervallo As Range
    Dim Righe, R, Colonne, C, FL As Boolean
    Sheets("Database").Select
    Set Intervallo = ActiveSheet.UsedRange
    Righe = Intervallo.Rows.Count
    Colonne = Intervallo.Columns.Count
    For R = Righe To 1 Step -1
    FL = False
    For C = 1 To Colonne
    If Intervallo(R, C) <> "" Then
    FL = True
    End If
    Next
    If FL = False Then
    Intervallo(R, 1).EntireRow.Delete
    End If
    Next
       
       
    'Pulusci foglio Home 

    Sheets("Home").Select
    Range("E5:E19").Select
    Range("E5:E19").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("H5:H19").Select
    Range("H5:H19").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
        
    Sheets("Home").Select
    Range("E5").Select
    
    Application.ScreenUpdating = True
    
End Sub

di Raffaele_53 (utente non iscritto) data: 26/04/2014 15:22:48
A me non si blocca, però non ho capito bene la richiesta dei due msgbox. Credo che desideri una verifica se la cella E5 sia piena per eseguire il codice che hai scritto. Incolla il tuo codice se desideri vuota/piena

Sub verifica()
    If Sheets("Home").Range("E5") = "" Then
        MsgBox "Vuota"
    Else
        MsgBox "Piena"
    End If
End Sub

Ps nota la differenza con il Tuo e se ci fossero anche le variabili dei fogli sarebbe meglio
    Sheets("Database").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Home").Range("E5").Copy
    Sheets("Database").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

di Textomb data: 26/04/2014 18:13:53
@ffante
cit. Questo codice lo dovrei inserire all'interno del codice sottostante.
Assolutamente no.
Il codice che ti ho scritto va inserito all'interno del foglio Home in corrispondenza dell'evento SelectionChange,
Ti guido passo passo.
Premi Alt-F11 entri all'interno del codice. Doppio clic in corrispondenza del foglio Home e selezioni l'evento selectionChange.
Solo a questo punto inserisci il codice che ti ho scritto. Così facendo ad ogni selezione nel foglio Home parte quell'evento.
Poi, a margine.
Ho dato un'occhiata al codice che hai riportato.
Ma fai un'infinità di operazioni che non servono.
Prova sostituendo l'intera routine con questa che scrivo qui sotto.

Sub Inserisci_Trattamento_Click_Textomb()

Dim i As Integer

    Sheets("Database").Rows("2:2").Insert Shift:=xlDown

    For i = 5 To 19 Step 2
        Sheets("Home").Range("e" & i & ",h" & i).Copy
        Sheets("Database").Cells(3, i - 4).PasteSpecial xlPasteValues
        Sheets("Home").Range("e" & i & ",h" & i).ClearContents
    Next

End Sub

Message box condizionata
di ffante (utente non iscritto) data: 26/04/2014 19:22:57
Con questo codice che mi hai inviato,nel caso in cui non inserisco nulla nel foglio Home e eseguo la routine mi viene cancellata la seconda riga nel foglio Database.

Nel caso di dati dentro le celle funziona...
di Textomb data: 26/04/2014 20:28:41
prova a sostituire la riga del codice che ho scritto
Sheets("Database").Cells(3, i - 4).PasteSpecial xlPasteValues
con questa
Sheets("Database").Cells(2, i - 4).PasteSpecial xlPasteValues

vedi un pò...

Message box condizionata
di ffante (utente non iscritto) data: 26/04/2014 23:38:59
Con la varizione che mi hai consgliato gli inserimenti accidentli senza dati non cancellano più la seconda riga.

Solo che anche con i dati all'interno della cella E5 del foglio Home mi da sempre il primo msgbox come se non ci

fosse niente all'interno.

Sub Inserisci_Trattamento_Click()
'
'   Macro1 
'
    Application.ScreenUpdating = False
'
    Dim i As Integer

    Sheets("Database").Rows("2:2").Insert Shift:=xlDown

    For i = 5 To 19 Step 2
        Sheets("Home").Range("e" & i & ",h" & i).Copy
        Sheets("Database").Cells(2, i - 4).PasteSpecial xlPasteValues
        Sheets("Home").Range("e" & i & ",h" & i).ClearContents
    Next

     
     If Sheets("Home").Range("E5") <> "" Then
        MsgBox "Non Hai inserito nessun dato"
    Else
        MsgBox "Inserimento eseguito con successo"
    End If
    
    
    'Elimina_Righe_Vuote 
    
    Dim Intervallo As Range
    Dim Righe, R, Colonne, C, FL As Boolean
    Sheets("Database").Select
    Set Intervallo = ActiveSheet.UsedRange
    Righe = Intervallo.Rows.Count
    Colonne = Intervallo.Columns.Count
    For R = Righe To 1 Step -1
    FL = False
    For C = 1 To Colonne
    If Intervallo(R, C) <> "" Then
    FL = True
    End If
    Next
    If FL = False Then
    Intervallo(R, 1).EntireRow.Delete
    End If
    Next
   
    'Pulusci foglio Home 
       
    Sheets("Home").Select
    Range("E5:E19").Select
    Range("E5:E19").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("H5:H19").Select
    Range("H5:H19").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
        
    Sheets("Home").Select
    Range("E5").Select
    
    Application.ScreenUpdating = True
    
End Sub

di Textomb data: 27/04/2014 00:44:49
Prova così
Speriamo che vada bene
Non è facile decifrare...

Sub Inserisci_Trattamento_Click_Textomb()

Dim i As Integer

    Sheets("Database").Rows("2:2").Insert Shift:=xlDown
    For i = 5 To 19 Step 2
        Sheets("Home").Range("e" & i & ",h" & i).Copy
        Sheets("Database").Cells(2, i - 4).PasteSpecial xlPasteValues
    Next
 
 
 If IsEmpty(Sheets("Home").Range("E5")) Then
        MsgBox "Non Hai inserito nessun dato"
Else
        MsgBox "Inserimento eseguito con successo"
End If

Sheets("Home").Range("E5:E19,H5:H19").ClearContents

End Sub

Message box condizionata
di ffante (utente non iscritto) data: 27/04/2014 01:23:19
Funziona perfettamente.

Ti vorrei proporre un altro quesito?

Dalla stessa maschera di inserimento Dal foglio (Home) devo copiare i dati della cella (E5 e H19)

sul foglio (Telefono) dalla seconda riga sulla cella a2 e b2.

ho provato col codice che mi hai mandato solo che mi scrive il valore della cella E5 del foglio (home) al posto

giusto invece il valore della cella H19 del foglio Home la copia sulla cella P2.

Ti riporto il codice sotto.

Sub Inserisci_Telefono_Click()
    
    'Inserisci_Telefono
    
    Application.ScreenUpdating = False
    
    Dim i As Integer

    Sheets("Telefono").Rows("2:2").Insert Shift:=xlDown

    For i = 5 To 19 Step 2
        Sheets("Home").Range("e" & i & ",h" & i).Copy
        Sheets("Telefono").Cells(2, i - 4).PasteSpecial xlPasteValues
        Sheets("Home").Range("e" & i & ",h" & i).ClearContents
     Next

di Textomb data: 27/04/2014 10:15:08
Se vuoi adattare un codice devi capire cosa esegue durante le varie operazioni.
Altrimenti vai solo a tentativi ma la probabilità che arrivi al risultato sperato è molto remota.
Nel codice di prima la cella E5 viene copiata nella cella A2 del foglio Database. Poi copia altre celle una accanto all'altra fino ad arrivare alla cella H19 che sarà copiata nella cella P2 del foglio Database.
Adesso se vuoi copiare solo due celle E5 e H19 in due celle contigue di un altro foglio (Telefono) il codice da eseguire sarà un altro totalmente diverso.

Sub Inserisci_Telefono_Click()
    
    'Inserisci_Telefono
        
    Sheets("Telefono").Rows("2:2").Insert Shift:=xlDown

        Sheets("Telefono").Range("a2").Value = Sheets("Home").Range("e5").Value
        Sheets("Telefono").Range("b2").Value = Sheets("Home").Range("h19").Value

' Se vuoi cancellare le due celle E5 e H19 dal Foglio Home dovrai eseguire la seguente istruzione
Sheets("Home").Range("e5,h19").ClearContents

End Sub

Message box condizionata
di ffante (utente non iscritto) data: 27/04/2014 13:16:05
Con questo codice che mi hai mandato funziona perfettamente.

Ti ringrazio tantissimo.

Vuoi Approfondire?