Inserire riga mediante un pulsante

Question

Buonasera a tutta la Community!

Vorrei fare una domanda.

Desidero inserire un pulsante di comando che mi consenta di inserire una nuova riga su una tabella in una specifica posizione che scelgo di volta in volta.

Ho trovato questo codice che fa QUASI al caso mio:

Private Sub InserisciProdotto()

ActiveSheet.Unprotect

    Dim rowNum As Integer

    On Error Resume Next

    rowNum = Application.InputBox(Prompt:="Seleziona la casella desiderata:", _

                                    Title:="INSERISCI PRODOTTO", Type:=1)

    Rows(rowNum & ":" & rowNum).Insert Shift:=xlDown

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

End Sub

Con questo codice, nel momento in cui avvio la Macro, compare una finestra la quale mi chiede di inserire il numero della riga dal quale crearne una nuova sotto.

Io vorrei selezionare direttamente la cella nella tabella anzichè scrivere manualmente il numero della riga...

Sarebbe possibile?

Grazie a tutti!!! :-)

Answer 1

Ciao Cristian,

Scusa Norman, non voleve mettere in dubbio la qualità del tuo codice.

Sicuramente ho sbagliato io qualcosa 😉

Linko un file il quale spiega praticamente cosa mi servirebbe nella speranza che tu possa continuare ad aiutarmi.

Grazie ancora per tutto!!

https://www.dropbox.com/s/rihzfqijfwp81rz/InserisciRiga.xlsm?dl=0

Ho scaricato il tuo file e ora capisco il problema - hai spostato i pulsanti sotto le rispettivi tabelle anzichè accanto le tabelle!

Quindi, prova la seguente versione del codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim rCell As Range

    Dim iRow As Long

    Dim oButton As Button

    Dim bExcelTable As Boolean

   Set oButton = ActiveSheet.Buttons(Application.Caller)

   Set rCell = oButton.BottomRightCell.Offset(-2, -1)

   rCell.Select

   On Error Resume Next

    bExcelTable = rCell.ListObject.Active

    On Error GoTo 0

    With rCell

        If bExcelTable Then

            iRow = .Row - .ListObject.HeaderRowRange.Row

            rCell.ListObject.ListRows.Add iRow + 1

        Else

            .Resize(1, .CurrentRegion.Columns.Count).Insert

        End If

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Grazie Norman, ma purtroppo non va...

Comunque a me va bene anche il codice che mi hai dato inizialmente ma l’unica cosa è che vorrei avere una finestra la quale mi chieda di scegliere la cella dal quale creare sotto una nuova riga in tabella; l’opzione del pulsante per ogni tabella era solo un eccesso di ingordigia 😉

va bene anche un solo pulsante che vale per tutti a parto che io possa selezionare la cella di volta in volta.

Grazie ancora e scusa per il disturbo :-)

Answer 3

Ciao Cristian,

Grazie mille per l’aiuto :-)

Ci siamo quasi perchè questo codice inserisce effettivamente una riga nuova in tabella ma inserisce la riga sulla cella attiva nel momento prima di avviare la Macro.

Sarebbe necessario per me che nel momento in cui avvio la Macro si aprisse una finestra la quale mi chiede di selezionare la cella dal quale creare la nuova riga sotto.

Sarebbe possibile questa aggiunta?

Un’altra figata (per me) sarebbe che la riga nuova si creasse nella cella immediatamente a destra rispetto al pulsante in modo tale che io possa iserire un pulsante su ogni tabella che ho nei vari fogli e lui (in base alla posizione del pulsante) inserisce una nuova riga.

Comunque non vorrei esagerare 😂

Va benissimo anche poter selezionare manualmente di volta in volta la cella desiderata 😊

grazie mille per il support!!

Prova a assegnare il seguente codice al pulsante accanto ad ogni tabella :

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim rCell As Variant 'Range

    Dim iRow As Long

    Dim oButton As Button

    Dim bExcelTable As Boolean

   Set oButton = ActiveSheet.Buttons(Application.Caller)

   Set rCell = oButton.BottomRightCell.Offset(0, 1)

   rCell.Offset(0, 1).Select

   On Error Resume Next

    bExcelTable = rCell.ListObject.Active

    On Error GoTo 0

    With rCell

        If bExcelTable Then

            iRow = .Row - .ListObject.HeaderRowRange.Row

            rCell.ListObject.ListRows.Add iRow

        Else

            .Resize(1, .CurrentRegion.Columns.Count).Insert

        End If

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 4

Ciao Norman!

Grazie mille per l’aiuto :-)

Ci siamo quasi perchè questo codice inserisce effettivamente una riga nuova in tabella ma inserisce la riga sulla cella attiva nel momento prima di avviare la Macro.

Sarebbe necessario per me che nel momento in cui avvio la Macro si aprisse una finestra la quale mi chiede di selezionare la cella dal quale creare la nuova riga sotto.

Sarebbe possibile questa aggiunta?

Un’altra figata (per me) sarebbe che la riga nuova si creasse nella cella immediatamente a destra rispetto al pulsante in modo tale che io possa iserire un pulsante su ogni tabella che ho nei vari fogli e lui (in base alla posizione del pulsante) inserisce una nuova riga.

Comunque non vorrei esagerare 😂

Va benissimo anche poter selezionare manualmente di volta in volta la cella desiderata 😊

grazie mille per il support!!

Answer 5

Ciao Cristian,

Vorrei fare una domanda.

Desidero inserire un pulsante di comando che mi consenta di inserire una nuova riga su una tabella in una specifica posizione che scelgo di volta in volta.

Ho trovato questo codice che fa QUASI al caso mio:

Private Sub InserisciProdotto()

ActiveSheet.Unprotect

    Dim rowNum As Integer

    On Error Resume Next

    rowNum = Application.InputBox(Prompt:="Seleziona la casella desiderata:", _

                                    Title:="INSERISCI PRODOTTO", Type:=1)

    Rows(rowNum & ":" & rowNum).Insert Shift:=xlDown

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False

End Sub

Con questo codice, nel momento in cui avvio la Macro, compare una finestra la quale mi chiede di inserire il numero della riga dal quale crearne una nuova sotto.

Io vorrei selezionare direttamente la cella nella tabella anzichè scrivere manualmente il numero della riga...

Sarebbe possibile?

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim rCell As Range

    Dim iRow As Long

    Dim bExcelTable As Boolean

    Set rCell = ActiveCell

    On Error Resume Next

    bExcelTable = rCell.ListObject.Active

    On Error GoTo 0

    With rCell

        If bExcelTable Then

            iRow = .Row - .ListObject.HeaderRowRange.Row

            rCell.ListObject.ListRows.Add iRow

        Else

            .Resize(1, .CurrentRegion.Columns.Count).Insert

        End If

    End With

End Sub

'<<=========

===

Regards,

Norman