Excel Forum

	Soluzioni Excel Domande e Risposte
		macro inserimento riga

Pagina precedente | 1 | Pagina successiva

Vota | Stampa | Notifica email

« Discussione Precedente | Lista | Discussione Successiva »

Autore

macro inserimento riga

Ultimo Aggiornamento: 25/04/2018 21:36

maxma62

Post: 776

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

25/04/2018 08:56

00#1

Ciao a tutti.
Nel workbook (tabella) allegato ho 2 macro:

Option Explicit

Sub aggiungi_copiaformato() 'aggiungi riga / in mezzo con messaggio
ActiveSheet.Unprotect "123456"
On Error Resume Next
Dim n As Long
Dim x As Long
Dim Avviso As String
n = ActiveCell.Row

If n < 2 Then

MsgBox ("In questo punto non puoi aggiungere righe"), vbCritical
Exit Sub
Else

'ActiveSheet.Unprotect "123456"
ActiveCell.EntireRow.Insert
x = ActiveCell.Row - 1
Cells(x, 1).EntireRow.Copy
Cells(ActiveCell.Row, 1).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
ActiveSheet.Protect "123456"

Rows(n).Cells(1).Select 'seleziona cella

End If
End Sub


Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    
Dim Rng As Range

 Application.EnableEvents = False
 
    ActiveSheet.Unprotect "123456"


'-------------------------------------------------------------------------

'per visualizzare username/data
    If Not Intersect(Target, Range("A2:E20")) Is Nothing Then '<<< range dove si visualizza
Cells(Target.Row, 5) = Date '17 colonna = Q
   End If
   
'-------------------------------------------------------------------------

  Application.EnableEvents = True
  
   ActiveSheet.Protect "123456"
    
  End Sub

che servono per inserire righe in fogli protetti con la data della modifica.
La macro: Sub aggiungi_copiaformato() è abbinata al pulsante nella tabella.
Funziona bene, solo che non so come "togliere" la data nella nuova riga inserita.
La macro per data deve restare perchè serve per altre macro.
Un saluto.
max

Download (18 KB)

____________________________
versione excel 365 ufficio
versione excel 2007 casa

locatevaresino

Post: 2.072

Registrato il: 21/03/2008

Città: LOCATE VARESINO

Età: 76

Utente Veteran

2007 / 13

OFFLINE

25/04/2018 10:32

00#2

ciao

modifica alla tua sub() in Modulo

Option Explicit

Sub aggiungi_copiaformato() 'aggiungi riga / in mezzo con messaggio
''ActiveSheet.Unprotect "123456"
On Error Resume Next
Dim n As Long
Dim x As Long
Dim Avviso As String
n = ActiveCell.Row

If n < 2 Then
MsgBox ("In questo punto non puoi aggiungere righe"), vbCritical
Exit Sub
Else
Application.EnableEvents = False ''spegnere ogni evento altrimenti si attiva la sub() data
ActiveSheet.Unprotect "123456" '' sproteggere in questo punto
ActiveCell.EntireRow.Insert
x = ActiveCell.Row - 1
Cells(x, 1).EntireRow.Copy
Cells(ActiveCell.Row, 1).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
ActiveSheet.Protect "123456"
Rows(n).Cells(1).Select 'seleziona cella
End If
Application.EnableEvents = True '' riaccendere
End Sub

Ciao da locate
excel 2007 / 13

patel45

Post: 4.081

Registrato il: 13/03/2012

Città: LIVORNO

Età: 78

Utente Master

2010

OFFLINE

25/04/2018 10:34

00#3

la data non viene aggiunta dalla sub che hai mostrato ma da questa

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Application.EnableEvents = False
ActiveSheet.Unprotect "123456"
If Not Intersect(Target, Range("A2:E20")) Is Nothing Then '<<< range dove si visualizza
   Cells(Target.Row, 5) = Date '17 colonna = Q
End If
Application.EnableEvents = True
ActiveSheet.Protect "123456"
End Sub

che entra in funzione quando modifichi una cella, quindi se non vuoi la data devi eliminare questa sub

[Modificato da patel45 25/04/2018 10:34]

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta

maxma62

Post: 776

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

25/04/2018 10:59

00#4

Ciao a tutti,
grazie locate ora dovrebbe essere o.k. [SM=g27811]

, la provo domani in ufficio.
Patel lo so che la macro in thisworkbook attiva la data, ma questa deve restare perchè serve ad altre macro.
Un saluto a tutti.
max

____________________________
versione excel 365 ufficio
versione excel 2007 casa

maxma62

Post: 777

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

25/04/2018 14:55

00#5

Ciao,
sempre per la stessa tabella ho aggiunto altre 2 macro:

Option Explicit

Sub EliminaRiga() 'elimina riga con messaggio
ActiveSheet.Unprotect "123456"
On Error Resume Next
Dim n As Long
Dim x As Long
Dim Avviso As String

'Avviso = MsgBox("cancellare il contenuto della riga/ghe selezionata/te?", vbYesNo + vbExclamation, "ATTENZIONE!")
'Avviso = MsgBox("cancellare il contenuto della riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")
Avviso = MsgBox("Elimino la riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")


If Avviso = vbYes Then
n = ActiveCell.Row

If n < 2 Then
'MsgBox ("Le prime 5 righe non si possono eliminare"), vbQuestion
MsgBox ("Le prime 2 righe non si possono eliminare"), vbCritical, ("ATTENZIONE!")

Exit Sub
Else
'Application.EnableEvents = False
'ActiveSheet.Unprotect "123456"

Selection.EntireRow.Delete
'Selection.EntireRow.ClearContents 'elimina più di una riga
'Rows(n).EntireRow.ClearContents 'elimina solo una riga

ActiveSheet.Protect "123456"
End If
End If
'Application.EnableEvents = True

 Rows(n).Cells(1).Select 'seleziona cella
'[A6].Select

End Sub

 
 
Option Explicit

Sub EliminaRiga_contenuto() 'elimina riga con messaggio
'ActiveSheet.Unprotect "123456"

On Error Resume Next
Dim n As Long
Dim x As Long
Dim Avviso As String

'Avviso = MsgBox("cancellare il contenuto della riga/ghe selezionata/te?", vbYesNo + vbExclamation, "ATTENZIONE!")
'Avviso = MsgBox("cancellare il contenuto della riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")
Avviso = MsgBox("Elimino la riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")


If Avviso = vbYes Then
n = ActiveCell.Row

If n < 2 Then
'MsgBox ("Le prime 5 righe non si possono eliminare"), vbQuestion
MsgBox ("Le prime 2 righe non si possono eliminare"), vbCritical, ("ATTENZIONE!")

Exit Sub
Else

'Application.EnableEvents = False
ActiveSheet.Unprotect "123456"

'Selection.EntireRow.Delete
Selection.EntireRow.ClearContents 'elimina più di una riga
'Rows(n).EntireRow.ClearContents 'elimina solo una riga

Call rimetti_formula

ActiveSheet.Protect "123456"
End If
End If

'Application.EnableEvents = True

 Rows(n).Cells(1).Select 'seleziona cella
'[A6].Select

End Sub

Sub EliminaRiga per eliminare tutta la riga selezionata
Sub EliminaRiga_contenuto per eliminare il contenuto della riga selezionata.
La prima macro funziona, la seconda EliminaRiga_contenuto non tanto.
Dovrebbe cancellare il contenuto rimettere le formule con Call rimetti_formula e non mettere la data della modifica.
Un aiuto?
Grazie,
max

Download (25 KB)

____________________________
versione excel 365 ufficio
versione excel 2007 casa

maxma62

Post: 778

Registrato il: 28/12/2009

Città: CITTADELLA

Età: 62

Utente Senior

excel 2007/365

OFFLINE

25/04/2018 21:36

00#6

Ho risolto secondo le mie possbilità aggiungendo:

'Selection.EntireRow.Delete
'Selection.EntireRow.ClearContents 'elimina più di una riga
'Rows(n).EntireRow.ClearContents 'elimina solo una riga

Rows(n).Cells(1).ClearContents 'cancella cella
Rows(n).Cells(2).ClearContents 'cancella cella
Rows(n).Cells(3).ClearContents 'cancella cella
Rows(n).Cells(5).ClearContents 'cancella cella

e togliendo call rimetti_formula che non serviva.


Sub EliminaRiga_contenuto() 'elimina riga con messaggio
'ActiveSheet.Unprotect "123456"
 
On Error Resume Next
Dim n As Long
Dim x As Long
Dim Avviso As String
 
'Avviso = MsgBox("cancellare il contenuto della riga/ghe selezionata/te?", vbYesNo + vbExclamation, "ATTENZIONE!")
'Avviso = MsgBox("cancellare il contenuto della riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")
Avviso = MsgBox("Elimino il contenuto della riga < " & ActiveCell.Row & " > selezionata? ", vbYesNo + vbExclamation, "ATTENZIONE!")
 
 
If Avviso = vbYes Then
n = ActiveCell.Row
 
If n < 2 Then
'MsgBox ("Le prime 5 righe non si possono eliminare"), vbQuestion
MsgBox ("Le prime 2 righe non si possono eliminare"), vbCritical, ("ATTENZIONE!")
 
Exit Sub
Else
 
Application.EnableEvents = False
ActiveSheet.Unprotect "123456"
 
'Selection.EntireRow.Delete
'Selection.EntireRow.ClearContents 'elimina più di una riga
'Rows(n).EntireRow.ClearContents 'elimina solo una riga
 
Rows(n).Cells(1).ClearContents 'cancella cella
Rows(n).Cells(2).ClearContents 'cancella cella
Rows(n).Cells(3).ClearContents 'cancella cella
Rows(n).Cells(5).ClearContents 'cancella cella
 
ActiveSheet.Protect "123456"
 
 Rows(n).Cells(1).Select 'seleziona cella
'[A6].Select

End If

'Application.EnableEvents = True

End If
     
Application.EnableEvents = True

End Sub

____________________________
versione excel 365 ufficio
versione excel 2007 casa

Vota:

Pagina precedente | 1 | Pagina successiva

Nuova Discussione

Rispondi

Cerca nel forum

Cerca

nei titoli, nei messaggi, con Google

cerca discussioni con titolo simile

Tag discussione

macro inserimento

Discussioni Simili [vedi tutte]

INSERIMENTO MACRO (7 messaggi, agg.: 16/11/2021 11:20)
Macro per inserimento immagini semiautomatico (18 messaggi, agg.: 01/12/2016 08:12)

macro inserimento riga

Anteprima