IMPLEMENTAZIONE INSERIMENTO RIGA SINGOLA DI RITORNO

[FROST220684Partecipante FROST220684]

Ciao a tutti, 

per svariati motivi di carattere tecnico, ho aggiunto all'userform che inserisce le righe in questo file nel foglio transfer la possibilità oltre che di inserire un transfer di sola andata anche di poter inserire un transfer di solo ritorno. ho un piccolo problema:

1. Quando flaggo inserisci transfer di solo ritorno tutto funziona (mi spariscono le textbox che non servono e mi fa inserire il transfer solo che non me lo collaca in modo corretto e cioè la riga va a finire in fondo creando anche delle righe vuote. 

invece dovrebbe inserirla in ordine di data e ordinare in automatico in numeri progressivi della tabella.

p.s. se lo faccio dalla checkbox "inserisci transfer di sola andata" funziona tutto correttamente, ma se lo faccio dall'altra checkbox mi da questo problema.

Allego un prima e un dopo oltre al fine prova.

Come vedete nella foto "dopo" invece di mettere la riga in ordine di data la mette alla fine, salta 5 numeri dal 233 al 238, e lascia una riga vuota

Grazie a tutti per l'aiuto

Allegati:

You must be logged in to view attached files.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Premesso che un Transfer di Ritorno lo puoi inserire solo dopo aver inserito quello d'andata.
>>>MsgBox "Non puoi compilare un RITORNO senza la corrispondente ANDATA." & vbNewLine & _
"Cerca prima le informazioni di andata, recuperandole dall'elenco sottostante, dopodiché " & _
"potrai compilare il ritorno.", vbInformation, "Attenzione"
Come si dovrebbe fare per inserire quello di ritorno, dato che non si può accedere alla TextBoxB (data) ed il tasto "inserisci riga" è disattivato?
Ps. Nel caso che Userform=vuota, Tu compili TextBoxB(data) + altre TextBox e poi premi tasto "inserisci riga", il codice prima inserisce una riga vuota e poi mette un Transfer di Ritorno. Non credo sia la procedura giusta da fare.
Pss. Rendi visibili le colonne K:L + le righe 3:232, seleziona le cella A3:L232 e metti in ordine tramite "Id-Transfer"
Noterai che per ogni nome c'è ANDATA & RITORNO, tranne alcune alla fine ed a queste chiedo come hai fatto ad inserirle?

[FROST220684Partecipante FROST220684]

Ciao Raffaele e grazie dell'interessamento,

quando mi riferisco a questo opzione da implementare vorrei fosse come la checkbox 1 dove se flaggata mi nasconde tutti i tasti e textbox non necessarie e mi inserisce una riga di sola andata. come vedrai nell'userform ha inserito anche quello di ritorno provando a modificare io stesso il codice, quindi il funzionamento dovrebbe essere lo stesso della checkbox1 solo che in questo caso andremo a flaggare la checkbox 2 ed andiamo inserire solo una riga di ritorno. ho provato a farlo da solo ed in effetti succede qualcosa in quanto la riga viene inserita solo che i problemi sono 2:

1. viene inserita in fondo alla pagina come ultima riga invece di essere messa in ordine di data

2. prima viene inserita una riga vuota

3. salta la numerazione in quanto la riga che viene inserita salta di circa 5 numeri quindi se l'ultima era la 233 questa riga che viene inserita verrà assegnato il numero 238

[FROST220684Partecipante FROST220684]

per completezza allego un video di quello che succede e le parti di codice che ho modificato e che secondo me sono interessate, ma probabilmente non ho modificato tutto in modo corretto perchè immagino che se ci sia la possibilità di inserire una riga di sola andata ci sia anche il modo di inserire una riga di solo ritorno by passando l'inserimento doppio di andata e ritorno insieme

Raffaele53 ha scritto:

Premesso che un Transfer di Ritorno lo puoi inserire solo dopo aver inserito quello d'andata. >>>MsgBox "Non puoi compilare un RITORNO senza la corrispondente ANDATA." & vbNewLine & _
"Cerca prima le informazioni di andata, recuperandole dall'elenco sottostante, dopodiché " & _
"potrai compilare il ritorno.", vbInformation, "Attenzione"
Come si dovrebbe fare per inserire quello di ritorno, dato che non si può accedere alla TextBoxB (data) ed il tasto "inserisci riga" è disattivato?

Quello che fai presente qui è vero ma dovrebbe funzionare solo quando vuoi inserire un doppio transfer A/R e le due checkbox 1 e 2 non sono flaggate, mentre se fleggo una delle 2 checkbox mi dovrebbe dare la possibilità di scegliere cosa inserire liberamente

Private Sub CheckBox2_Click()
    Call form_checkbox2_click(Me)
    Label1.Visible = Not CheckBox2
    TextBoxA.Visible = Not CheckBox2
    Label8.Visible = Not CheckBox2
    TextBox7.Visible = Not CheckBox2
    Label18.Visible = Not CheckBox2
    TextBox10.Visible = Not CheckBox2
    CheckBox1.Visible = Not CheckBox2
    
End Sub

 

Private Sub btnInsert_Click()
'inserisce i dati delle textbox nel foglio corrispondente al form
Dim i As Long
Dim f As Range
Dim r As Range
Dim id As Long

    If TextBoxA = "" And TextBoxB = "" Then
        set_info Me, "Dati incompleti. Inserire almeno una data."
        TextBoxA.Tag = 0
        Exit Sub
    End If
    
    If IsDate(TextBoxA) And IsDate(TextBoxB) Then
        If CDate(TextBoxB) < CDate(TextBoxA) Then
            set_info Me, "Non posso inserire i dati. La prima data non può essere superiore alla seconda."
            TextBoxA.Tag = 0
            Exit Sub
        End If
    End If
    
    set_info Me, ""
    
    id = [Id_Transfer] + 1
    
    Set f = active_table(Me)
    i = f.Rows.Count + 3    'prima riga libera in cui inserire i dati nuovi e ID di questo inserimento
    Set f = Rows(i).Resize(, f.Columns.Count)
    
    With f
    .Select
        .Interior.Color = xlNone
        .Font.Size = 12
        .Font.Bold = False
        .Font.Name = "Calibri"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .WrapText = True
        
        'compilare l'andata?
        If TextBoxA <> "" Then
            .Cells(1) = i                   'N
            .Cells(2) = CDate(TextBoxA)     'data
            .Cells(3) = TextBox3            'ospite
            .Cells(4) = Val(TextBox4)       'n° passeggeri
            .Cells(5) = TextBox5            'destinazione da
            .Cells(6) = TextBox6            'destinazione per
            .Cells(7) = TextBox7            'ora arrivo
            
            'in funzione di checkbox1 salvo ora partenza e transfer se compilati
            .Cells(8) = IIf(CheckBox1, TextBox8, "")        'ora partenza
            .Cells(9) = IIf(CheckBox1, TextBox9, "")        'ora transfer
            
            .Cells(10) = TextBox10    'note
            
            .Cells(11) = "A"   'A/R
            .Cells(12) = "Id-" & Right("0000" & id, 5)  'nr. Id
            
            'formattazione colonna 1
            .Cells(1).Interior.Color = 15853019
            .Cells(1).Font.Bold = True
            
            .EntireRow.AutoFit
        End If
    End With
        
    'compilare il ritorno?
    If TextBoxB <> "" Then
        
        
        If TextBoxA = "" Then
            MsgBox "Non puoi compilare un RITORNO senza la corrispondente ANDATA." & vbNewLine & _
            "Cerca prima le informazioni di andata, recuperandole dall'elenco sottostante, dopodiché " & _
            "potrai compilare il ritorno.", vbInformation, "Attenzione"
            Exit Sub
        End If
        
        

        Set f = f.Offset(1)     'avanza di una riga per inserire eventualmente le info di ritorno
        With f
            .Interior.Color = xlNone
            .Font.Size = 12
            .Font.Bold = False

            .Font.Name = "Calibri"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .WrapText = True
            
            i = i + 1
            .Cells(1) = i             'N
            .Cells(2) = CDate(TextBoxB)      'data
            .Cells(3) = TextBox3        'ospite
            .Cells(4) = Val(TextBox4)   'n° passeggeri
            .Cells(5) = TextBox6        'destinazione per
            .Cells(6) = TextBox5        'destinazione da
            .Cells(7) = ""              'ora arrivo
            .Cells(8) = TextBox8        'ora partenza
            .Cells(9) = TextBox9        'ora transfer
            .Cells(10) = TextBox11      'note
            .Cells(11) = "R"            'A/R
            .Cells(12) = "Id-" & Right("0000" & id, 5)  'nr. Id
            
            'formattazione colonna 1
            .Cells(1).Interior.Color = 15853019
            .Cells(1).Font.Bold = True
            
            .EntireRow.AutoFit
        End With
    End If
    
    '-----------------------------------------------
    'un trucco per il riordinamento...
    'memorizza le date come valori in ultima colonna
    'riordina sulla base di questa e poi la cancella
    Set f = active_table(Me)
    f.Offset(, 12).Cells(1) = "#"
    Set f = f.Offset(1, 1).Resize(f.Rows.Count - 1, 1)
    f.Select
    For Each r In f
        r.Offset(, 11) = CLng(CDate(r))
    Next
    
    With active_table(Me)
        .Sort key1:=.Columns(13), Order1:=xlAscending, Header:=xlYes
        .Columns(13).Delete
    End With

    'aggiusta la colonna numerica A
    Set f = f.Offset(, -1)
    f.Select
    f(1) = 1
    f(1).AutoFill f, xlFillSeries
    '-----------------------------------------------
    
    ThisWorkbook.Names("Id_Transfer").Value = id
    
    If CheckBox1 Then CheckBox1 = False
    If CheckBox2 Then CheckBox2 = False
    
    Call btnClear_Click
    
        
    TextBoxA.Tag = 1
    f(1).Select
    set_info Me, "Inserimento eseguito correttamente."
End Sub

Allegati:

You must be logged in to view attached files.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Troppo complesso per modificare questo codice-pesante. Io mi preocuperei di sapere per quale motivo questo files tende a bloccarsi e per quale motivo quando si esce dall'userform debba lavorare altri 15 secondi. Ripeto non sono favorevole nel modificare questo codice, pertanto ho fatto una piccola modifica= Se la TextBoxA è nascosta esegue codice sino all'Else.
If Not TextBoxA.Visible Then
.....pezzi di mio/tuo codice
Else
.....il codice precedente (si deve trovare dove sia "Id_Transfer")
end if
Significa che apri Userform e devi spuntare "Inserisci Transfer Solo Ritorno"
Dato che non riesco a capire dove sia >>>id = [Id_Transfer] + 1<<< riordino il DB e prendo l'ultimo valore in colonna "L". Quando metterai Transfer Andata avrai ancora i numeri errati.

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

Ti ringrazio per la risposta e per l'aiuto proverò il file e ti aggiorno.

Raffaele53 ha scritto:

Troppo complesso per modificare questo codice-pesante. Io mi preocuperei di sapere per quale motivo questo files tende a bloccarsi e per quale motivo quando si esce dall'userform debba lavorare altri 15 secondi

ti do perfettamente ragione ma non ho le competenze per pormi questi quesiti da solo, e con molta franchezza devo badare alla sostanza e cioè far lavorare correttamente il file per quello che serve per lavoro, se ci mette 15 secondi in più purtroppo me lo faccio andare bene.

Raffaele53 ha scritto:

Quando metterai Transfer Andata avrai ancora i numeri errati.

se la tua preoccupazione è successiva ad un possibile inserimento dell'andata per quello stesso ospite e quindi far combaciare l'ID transfer, non esiste il problema perchè uso questa opzione per svariati motivi che non mi dilungo a spiegare ma solo per creare una riga diretta di ritorno (che in realtà forse sarebbe meglio chiamare "Inserire Tratta singola da Hotel - Ritorno) che non avrà mai un andata. Non so se mi sono spiegato. Ad ogni modo io sono sempre aperto alle spiegazioni se posso aiutare in qualche modo. Sono consapevole che per chi lo guarda per la prima volta sembra complesso, speravo infatti riuscissero ad interfacciarsi Vecchio_frac e Alex81 che conoscono abbastanza bene il codice ma sicuramente saranno impegnatissimi e non pretendo assolutamente che vengano in mio soccorso ci mancherebbe. Quello che si può fare bene, Quello che non si può non sarà mai una pretesa.

Grazie a tutti

Grazie Raffaele, ti farò sapere

 

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Non riesco trovare dove viene salvato "Id_Transfer", comunque con questo puoi aggiustare il numero ex

Sub Id__Transfer()
ThisWorkbook.Names("Id_Transfer").Value = 150
End Sub

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

aggiustare il numero ex

cosa intendi non capisco

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

Non riesco trovare dove viene salvato "Id_Transfer", comunque con questo puoi aggiustare il numero ex

se intendi con quale codice si inserisce il numero di id transfer penso sia questa riga

.Cells(12) = "Id-" & Right("0000" & id, 5)  'nr. Id

possibile?

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Di norma se aggiungi una riga "Id_Transfer" aumenta di 1, se Tu cancelli una riga "Id_Transfer" diminuisce di 1. Questo va bene finchè cancelli righe unicamente tramite codice, se cancelli/aumenti fisicamente le righe senza usare l'Userform "Id_Transfer" sballa.
Se Tu usi l'allegato e provi ad inserire una riga noterai che "Id_Transfer" è sballato =160. Avviando il codice sopra con 153 "Id_Transfer" ridiventa giusto (per me è un metodo non valido). Ora se Tu userai unicamente/sempre (Solo Ritorno), "Id_Transfer" sarà giusto perchè ho cambiato il metodo per trovarlo.
Quella Tua riga scrive "Id_Transfer" in colonna "L" = ID-00005 ecc ecc
Questa è la riga che memorizza "Id_Transfer" nel files (mà non sò dove lo scrive, si vede che è una proprietà particolare del files)
>>>ThisWorkbook.Names("Id_Transfer").Value = id

Ho fatto alcune modifiche, se vuoi provarlo (nessuna garanzia)

`Private Sub btnInsert_Click()
Dim i As Long
Dim f As Range
Dim r As Range
Dim id As Long
Rows(3 & ":" & 10000).EntireRow.Hidden = False
Columns("K:L").EntireColumn.Hidden = False
i = Sheets("Transfer").Range("A" & Rows.Count).End(xlUp).Row
id = Evaluate("SUMPRODUCT(LARGE(MID(L4:L" & i & ",4,5)*1,1))") + 1
Set f = active_table(Me)
If CheckBox1 = False And CheckBox2 = False Then MsgBox "Devi flagare Andata oppure Ritorno": Exit Sub
If Not TextBoxA.Visible Then
    i = i + 1
    If Not IsDate(TextBoxB) Then MsgBox "Non è una data valida": Exit Sub
    Set f = Rows(i).Resize(, f.Columns.Count)
        Set f = f.Offset
        With f
            .Interior.Color = xlNone
            .Font.Size = 12
            .Font.Bold = False
            .Font.Name = "Calibri"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .WrapText = True
            Cells(235, 1).Activate
            .Cells(1) = i - 3           'N
            .Cells(2) = CDate(TextBoxB)      'data
            .Cells(3) = TextBox3        'ospite
            .Cells(4) = Val(TextBox4)   'n° passeggeri
            .Cells(5) = TextBox6        'destinazione per
            .Cells(6) = TextBox5        'destinazione da
            .Cells(7) = ""              'ora arrivo
            .Cells(8) = TextBox8        'ora partenza
            .Cells(9) = TextBox9        'ora transfer
            .Cells(10) = TextBox11      'note
            .Cells(11) = "R"            'A/R
            .Cells(12) = "Id-" & Right("0000" & id, 5)  'nr. Id
            'formattazione colonna 1
            .Cells(1).Interior.Color = 15853019
            .Cells(1).Font.Bold = True
            .EntireRow.AutoFit
        End With
    '-----------------------------------------------
    Sheets("Transfer").Sort.SortFields.Clear
    Sheets("Transfer").Sort.SortFields.Add2 Key:=Range("B4:B" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Transfer").Sort
        .SetRange Range("A3:L" & i)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Transfer").Range("A4") = "1"
    Sheets("Transfer").Range("A4").AutoFill Destination:=Range("A4:A" & i), Type:=xlFillSeries
    TextBoxB.Tag = 1
    f(1).Select
    set_info Me, "Inserimento eseguito correttamente."
ElseIf Not TextBoxB.Visible Then
     i = i + 1
If Not IsDate(TextBoxA) Then MsgBox "Non è una data valida": Exit Sub
    Set f = Rows(i).Resize(, f.Columns.Count)
        Set f = f.Offset
        With f
            .Interior.Color = xlNone
            .Font.Size = 12
            .Font.Bold = False
            .Font.Name = "Calibri"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .WrapText = True
            Cells(235, 1).Activate
            .Cells(1) = i - 3           'N
            .Cells(2) = CDate(TextBoxA)      'data
            .Cells(3) = TextBox3        'ospite
            .Cells(4) = Val(TextBox4)   'n° passeggeri
            .Cells(5) = TextBox6        'destinazione per
            .Cells(6) = TextBox5        'destinazione da
            .Cells(7) = ""              'ora arrivo
            .Cells(8) = TextBox8        'ora partenza
            .Cells(9) = TextBox9        'ora transfer
            .Cells(10) = TextBox11      'note
            .Cells(11) = "R"            'A/R
            .Cells(12) = "Id-" & Right("0000" & id, 5)  'nr. Id
            'formattazione colonna 1
            .Cells(1).Interior.Color = 15853019
            .Cells(1).Font.Bold = True
            .EntireRow.AutoFit
        End With
    '-----------------------------------------------
    Sheets("Transfer").Sort.SortFields.Clear
    Sheets("Transfer").Sort.SortFields.Add2 Key:=Range("B4:B" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Transfer").Sort
        .SetRange Range("A3:L" & i)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Transfer").Range("A4") = "1"
    Sheets("Transfer").Range("A4").AutoFill Destination:=Range("A4:A" & i), Type:=xlFillSeries
    TextBoxA.Tag = 1
    f(1).Select
    set_info Me, "Inserimento eseguito correttamente."
End If
End Sub`

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

Ora se Tu userai unicamente/sempre (Solo Ritorno),

Ciao Raffaele scusa ma sono stato assente. Rispetto a questo è chiaro che non è possibile utilizzare solo la funzione ritorno.

L'unico che potrebbe chiarire la situazione sarebbe alex ma immagino non riesca a lavorarci.

Il codice ID serve ad indentificare andate e ritorni di un unico cliente a cui viene associato lo stesso ID e quindi un dato che non può sballare.

Con franchezza era una miglioria venuta fuori dal lavoro di una stagione ma il file funziona in modo corretto e non voglio creare danni o cambiare sistema pensavo fosse più facile andando a replicare la funzione solo andata anche per il ritorno ma mi pare sia travagliata la cosa quindi va bene cosi. Grazie mille

[Autore]

Articoli