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 mille Norman!

Funziona anche troppo bene :-)

Grazie ancora per l'aiuto!!

Answer 3

Grazie Norman!

Lo proverò al più presto e ti farò sapere :-)

Effettivamente ho spostato i pulsanti sotto le tabelle, ma se ci fai caso, sul lato destro c’erano delle tabelle con il pulsante sul lato SX in basso in quanto per alcuni fogli ho bisogno del pulsante sotto la tabella e su altri fogli ho bisogno del pulsante sul lato SX delle tabelle.

Cmq ti ringrazio veramente tanto 👍

Ti aggiorno più tardi 😉

Answer 4

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

Answer 5

Ciao Cristian,

Grazie Norman, ma purtroppo non va...

[...]

A me il codice funziona senza problema.

Ti chiederei gentilmente di caricare il file problematico, dopo averlo depurato dei dati sensibili, su un servizio di condivisione di file, ad esempio Microsoft OneDrive o DropBox, e postare un link al file in una risposta qui.

Per caricare il file su DropBox, vedi:

Come faccio a condividere file e cartelle in Dropbox?

===

Regards,

Norman