inserire data in riga aggiuntiva

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao a tutti, tramite la “txt_data_rich_correlate” avrei necessità di inserire la data qui scritta e trasferirla sul foglio di lavoro ma nella riga aggiuntiva.

 Uso questo codice

arr(nRows + 1, 18) = CDate(Format(Txt_data_rich_correlate, "dd/mm/yy"))

ma una volta spinto il pulsante “Inserisci” non la visualizzo.

 Perché ?

 

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Puoi aggiungere il codice assegnato al pulsante "inserisci"? Grazie

Ciao,

Mario

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao, eccolo

grazie

 

Private Sub caricacomboRicerca()
    Dim ur As Long, i As Long
    
    ur = Cells(Rows.Count, "A").End(xlUp).Row
    
    If ur < 2 Then Exit Sub '<--se non sono presenti nominativi allora non caricare nulla
    
    With cboRicerca
        .Clear
        .ColumnCount = 2 '<--imposto la ComboBox a 2 colonne
        .ColumnWidths = "0 pt" '<--la prima colonna non la mostro
             
        
         For i = 2 To ur
         If i Mod 2 = 0 Then
         .AddItem i '<--carico in colonna 1 della ComboBox il numero di riga in modo da poterlo sfruttare al momento di eventuali modifiche/eliminazioni/caricamenti
         .List(.ListCount - 1, 1) = Cells(i, "A").Value & " " & Cells(i, "B").Value '<--carico in colonna 2 il contatore ed il nominativo
         End If
        Next i

        
    End With
End Sub
Private Sub CmdCalcolatrice_Click()
UserForm2.Show
End Sub

Private Sub cmdInvia_Click()
    Dim contatore As Long
    Dim rigaDebitore As Variant
    Dim ctl As Control
    Dim arr() As Variant
    Dim r As Long, c As Long, nRows As Long, nCols As Long, k As Long
    Dim temp1 As Variant, regolarita As Variant
    Dim aziendaCedente As String
    Dim f As Range
    Dim wsFee As Worksheet
    
      If Trim(TxtContatore.Value) = "" Then Exit Sub
    
 
    
      
    'per ogni controllo nella UserForm
    For Each ctl In Me.Controls
        'se il controllo è una TextBox o ComboBox allora...
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            'ad esclusione della ComboBox cboRicerca...
            If ctl.Name <> "cboRicerca" Then
                If Trim(ctl.Value) = "" Then
                    MsgBox "Inserire " & ctl.Tag, vbExclamation, "Alert"
                    ctl.SetFocus
                    Exit Sub
                End If
            End If
        End If
    Next ctl

    contatore = TxtContatore.Value

    
    Set wsFee = ThisWorkbook.Worksheets("FEE")
    Set f = wsFee.Columns("A").Find(What:=TxtMandato.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then aziendaCedente = f.Offset(, 1).Value
    
    nRows = Cells(Rows.Count, "F").End(xlUp).Row
    nCols = 19
    ReDim arr(1 To (nRows + 1), 1 To nCols) As Variant
    
    For r = LBound(arr, 1) To nRows - 1
        For c = LBound(arr, 2) To nCols
            arr(r, c) = Cells(r + 1, c).Value
        Next c
    Next r
    arr(nRows, 1) = contatore 'A
    arr(nRows, 2) = TxtCliente 'B
    arr(nRows, 3) = CDate(Format(TxtDataOper, "dd/mm/yy")) 'C
    arr(nRows, 4) = aziendaCedente
    arr(nRows, 5) = TxtMandato.Value 'E
    arr(nRows, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<-- da replicare
    'arr(nRows, 7) = CLng(arr(nRows, 6)) - CLng(Date) 'G
    arr(nRows, 8) = TxtDebOrigin.Value
    arr(nRows, 9) = TxtAccord.Value 'I
    arr(nRows, 10) = TxtNumRate.Value 'J
    arr(nRows, 11) = TxtNumRate.Value 'K
    arr(nRows, 12) = TxtDaPag.Value 'L
    arr(nRows, 13) = "No"
    
 
    
    arr(nRows, 15) = "No"
 
    If TxtNumRate > 1 Then
        arr(nRows, 14) = "PLURI" 'N
    Else
        arr(nRows, 14) = "UNI" 'N
    End If
            
    If TxtDirLiber = "S" Then
        arr(nRows, 16) = "Si" 'P
    Else
        arr(nRows, 16) = "No"
    End If
    
    arr(nRows, 17) = "No" 'Q
    
    If TxtCorrelate = "S" Then
        arr(nRows, 18) = "Si" 'R
    Else
        arr(nRows, 18) = "No"
    End If
        
    Select Case TxtModalPag 'S
        Case 1
            arr(nRows, 19) = "Bonif"
        Case 2
            arr(nRows, 19) = "B_post"
        Case 3
            arr(nRows, 19) = "QrCode"
        Case Else
            arr(nRows, 19) = "null"
    End Select
    arr(nRows + 1, 2) = TxtCodfisc.Value 'B - C.F. in seconda riga
    arr(nRows + 1, 3) = TxtTelefono.Text 'C - Nr. di telefono in seconda riga
    arr(nRows + 1, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<--replicato
    arr(nRows + 1, 18) = CDate(Format(Txt_Data_ultima_rich_correlate, "dd/mm/yy")) 'R <-- replicato
    
    'Bubble Sort
    For r = 1 To UBound(arr, 1) - 2 Step 2
        For c = r + 2 To UBound(arr, 1) Step 2
            If UCase(arr(c, 2)) < UCase(arr(r, 2)) Then
                ReDim temp1(1 To 2, 1 To UBound(arr, 2))
                
                For k = 1 To UBound(arr, 2)
                    temp1(1, k) = arr(r, k)
                Next k
                temp1(2, 2) = arr(r + 1, 2)
                temp1(2, 3) = arr(r + 1, 3)
                temp1(2, 6) = arr(r + 1, 6)
                
                For k = 1 To UBound(arr, 2)
                    arr(r, k) = arr(c, k)
                Next k
                arr(r + 1, 2) = arr(c + 1, 2)
                arr(r + 1, 3) = arr(c + 1, 3)
                arr(r + 1, 6) = arr(c + 1, 6)
                
                For k = 1 To UBound(arr, 2)
                    arr(c, k) = temp1(1, k)
                Next k
                arr(c + 1, 2) = temp1(2, 2)
                arr(c + 1, 3) = temp1(2, 3)
                arr(c + 1, 6) = temp1(2, 6)
            End If
        Next c
    Next r
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    If nRows > 1 Then
        On Error Resume Next
        Range("A2:S" & nRows).ClearContents
        On Error GoTo 0
    End If
    
    For r = LBound(arr, 1) To UBound(arr, 1)
        Cells(r + 1, "A").Value = arr(r, 1)
        Cells(r + 1, "B").Value = arr(r, 2)
        If IsDate(arr(r, 3)) And InStr(arr(r, 3), "/") > 0 Then
            Cells(r + 1, "C").NumberFormat = "dd/mm/yy"
        Else
            Cells(r + 1, "C").NumberFormat = "General"
        End If
        Cells(r + 1, "C").Value = arr(r, 3)
        Cells(r + 1, "D").Value = arr(r, 4)
        Cells(r + 1, "E").Value = arr(r, 5)
        Cells(r + 1, "F").Value = arr(r, 6)
        If (r + 1) Mod 2 = 0 Then
            Cells(r + 1, "G").FormulaLocal = "=SE(M" & (r + 1) & "=""Si"";""PAGATO"";F" & (r + 2) & "-OGGI())"
        End If
        
        If Not IsEmpty(arr(r, 8)) And IsNumeric(arr(r, 8)) Then
            Cells(r + 1, "H").NumberFormat = "#,##0.00"
            Cells(r + 1, "H").Value = CDbl(arr(r, 8))
        Else
            Cells(r + 1, "H").NumberFormat = "#,##0.00"
        End If
        
        If Not IsEmpty(arr(r, 9)) And IsNumeric(arr(r, 9)) Then
            Cells(r + 1, "I").NumberFormat = "#,##0.00"
            Cells(r + 1, "I").Value = CDbl(arr(r, 9))
        Else
            Cells(r + 1, "I").NumberFormat = "#,##0.00"
        End If
        
        Cells(r + 1, "J").Value = arr(r, 10)
        Cells(r + 1, "K").Value = arr(r, 11)
        
        If Not IsEmpty(arr(r, 12)) And IsNumeric(arr(r, 12)) Then
            Cells(r + 1, "L").NumberFormat = "#,##0.00"
            Cells(r + 1, "L").Value = CDbl(arr(r, 12))
        Else
            Cells(r + 1, "L").NumberFormat = "#,##0.00"
        End If
        
        Cells(r + 1, "M").Value = arr(r, 13)
        Cells(r + 1, "N").Value = arr(r, 14)
        Cells(r + 1, "O").Value = arr(r, 15)
        Cells(r + 1, "P").Value = arr(r, 16)
        Cells(r + 1, "Q").Value = arr(r, 17)
        Cells(r + 1, "R").Value = arr(r, 18)
        Cells(r + 1, "S").Value = arr(r, 19)
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Call cmdReset_Click
    
                caricacomboRicerca
                
    On Error Resume Next
    rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0)
    On Error GoTo 0
    
    If Not IsError(rigaDebitore) Then
        Range("B" & rigaDebitore).Select
    End If

    MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso"
    
    TxtContatore.SetFocus


End Sub

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

@frasubb 

Ma tutto questo codice lo hai scritto tu?

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao, solo qualche piccolo pezzettino 

[alfrimpaPartecipante alfrimpa Karma: 33 pts]

Questa discussione è stata marcata come "RISOLTA" mi farebbe piacere sapere come.

[FrasubbPartecipante Frasubb Karma: 1 pt]

ho creato una seconda userform che mi gestisce dei dati specifici tra cui l'inserimento di questa data.

Questo il codice assegnato al CommandButton

Private Sub CmdConfermaCorrelate_Click()

        
     Dim rigaContatore As Long

    ' Verifica se è stato selezionato un elemento
    If CboCercaNom.ListIndex = -1 Then Exit Sub
    
    ' Chiede conferma all'utente
    If MsgBox("Sei sicuro di voler confermare le nuove scelte?", vbQuestion + vbYesNo, "Conferma scelte") = vbNo Then Exit Sub

    ' Prelevo il numero di riga (Assicurati che CboCercaNom.Value sia un numero valido)
    rigaContatore = CLng(CboCercaNom.Value)


  ' Colonna R: Correlate e Data
    Cells(rigaContatore, "R").Value = IIf(ChkCorrelate.Value, "Si", "")
    
    If Txt_Data_ultima_rich_correlate.Value <> "" Then
        Cells(rigaContatore + 1, "R").Value = DateValue(Txt_Data_ultima_rich_correlate.Value)
    End If

    ' Chiusura Userform
    Unload Me
    
     
End Sub

e questo alla Textbox specifica

Private Sub Txt_Data_ultima_rich_correlate_Change()

    Dim s As String

    s = Replace(Txt_Data_ultima_rich_correlate.Text, "/", "")
    If Not IsNumeric(s) Then Exit Sub

    If Len(s) > 8 Then s = Left(s, 8)

    Select Case Len(s)
        Case Is <= 2
            Txt_Data_ultima_rich_correlate.Text = s
        Case Is <= 4
            Txt_Data_ultima_rich_correlate.Text = Left(s, 2) & "/" & Mid(s, 3)
        Case Else
            Txt_Data_ultima_rich_correlate.Text = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Mid(s, 5)
    End Select

    Txt_Data_ultima_rich_correlate.SelStart = Len(Txt_Data_ultima_rich_correlate.Text)
End Sub

[Autore]

Articoli