You are here:---Rispondi a: SALVA FILE
Rispondi a: SALVA FILE 2018-07-22T19:45:27+00:00

Home Forum Domande su Excel VBA e MACRO SALVA FILE Rispondi a: SALVA FILE

franco56
Partecipante
    Post totali: 11

    Questo è il codice abbastanza veloce se tolgo WK.SAVE migliora ma come salvare ad ogni inserimento

    Private Sub CommandButton1_Click() ' inserisci riga
    Dim ix As Long
    Dim V As Double
    Dim Cl As Object
    Dim risposta As Integer
    Dim rigaR As Range
    Dim sRiga
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim M1, M2 As Date     'dichiarazione variabili come tipo di Date/Time per D1 e D2
    Dim tempoimpiegato As String  ' tempoimpiegato è una stringa
    Dim j As Long, LastRow As Long
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim row
    
    screenUpdateStatus = Application.ScreenUpdating
     statusBarStatus = Application.DisplayStatusBar
     calcStatus = Application.Calculation
     eventsStatus = Application.EnableEvents
     displayPageBreakStatus = ActiveSheet.DisplayPageBreaks
     Application.ScreenUpdating = False
     Application.DisplayStatusBar = False
     Application.Calculation = xlCalculationManual
     Application.EnableEvents = False
     ActiveSheet.DisplayPageBreaks = False
    
    Set wk = Workbooks("primanotacassa.xls")
    Set sh = wk.Worksheets("primanota")
    
    'SH.Activate
    'ActiveSheet.Unprotect
    'sh.EnableCalculation = False
    
    M1 = Time
    TextBox8 = M1
                 
    row = CInt(UserForm1.ComboBox1) + 1
    If Not row = vbNullString Then
       sh.Range("A" & row + 1).EntireRow.Insert
    End If
               
    With Sheets("primanota")
        Cells(row + 1, 1) = Val(UserForm1.ComboBox1)
         If TextBox1 <> "" Then Cells(row + 1, 2) = CDate(UserForm1.TextBox1)
         Cells(row + 1, 3) = UserForm1.TextBox2
         Cells(row + 1, 4).EntireRow.AutoFit  ' adatta altezza cella
           
         On Error Resume Next
        ' se vuoi inserire tre righe variare il parametro a 3
         n = Split(UserForm1.TextBox3, vbCr, 2)
                primariga = UCase(n(0))
                
                If n(1) <> "" Then
                secondariga = n(1)
                Else
                secondariga = ""
                End If
        Cells(row + 1, 4) = UCase(primariga) & LCase(secondariga)
        Resume Next
          
        Cells(row + 1, 5) = CDbl(UserForm1.TextBox4)
        Cells(row + 1, 6) = CDbl(UserForm1.TextBox5)
        Cells(row + 1, 8) = CDbl(UserForm1.TextBox6)
        Cells(row + 1, 9) = CDbl(UserForm1.TextBox7)
    End With
    
    With sh 'formula su colonna G
    '.Range("G3:G" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    .Range("G3:G" & .Cells(Rows.Count, 1).End(xlUp).row).FormulaR1C1 = "=IF(RC[-5]="""","""",IF(AND(OR(RC[-2]<>"""",RC[-1]<>"""",OR(RC[-2]="""",RC[-1]=""""))),R[-1]C+RC[-2]-RC[-1]))" 'inserisce formula colonna G
    End With
    
    'progressivo
    With sh
    ' Dim i As Long
    ' Dim V As Double
    V = 1
    For ix = 2 To .Cells(Rows.Count, 1).End(xlUp).row
    .Cells(ix, 1).Value = V
    V = V + 1
    Next
    End With
    
    '++++++++++++++++++++++++++++++++++++++++carico listbox++++++++++++++++++++++++++++++++++++++++++++++++++++
    '(6) carico la listbox1
    Set f = Sheets("primanota")
    Set D = CreateObject("Scripting.Dictionary")
    a = f.Range("A2:I" & f.[A65000].End(xlUp).row).Value
    For j = LBound(a) To UBound(a)
    LunghMax = 10
    
    a(j, 2) = Format(a(j, 2), "dd/mm/yyyy")
    
    'a(i, 4) = Replace(Replace(a(i, 4), Chr(10), " "), Chr(13), " ")                               'movimenti
    a(j, 4) = Application.Trim(Replace(Replace(a(j, 4), Chr(10), " "), Chr(13), " "))      'elimina ritorono a capo , avanzamento linea e spazi
    
     a(j, 5) = Format(a(j, 5), "#,###.00")
    NrSpazi_E = Int(LunghMax - 1 - Int(Len(Trim(a(j, 5)))))                                      'entrate
    a(j, 5) = Space(NrSpazi_E) & a(j, 5) '& Chr(124)
      
     a(j, 6) = Format(a(j, 6), "#,###.00")
     NrSpazi_F = Int(LunghMax - 1 - Int(Len(Trim(a(j, 6)))))
    a(j, 6) = Space(NrSpazi_F) & a(j, 6) ' & Chr(124)
    
    a(j, 7) = Format(a(j, 7), "#,###.00")
    NrSpazi_G = Int(LunghMax - Int(Len(Trim(Format(a(j, 7), "#,###.00")))))
    a(j, 7) = Space(NrSpazi_G) & a(j, 7) '& Chr(124)
    
    a(j, 8) = Format(a(j, 8), "#,###.00")
    NrSpazi_H = Int(LunghMax - 1 - Int(Len(Trim(a(j, 8)))))
    a(j, 8) = Space(NrSpazi_H) & a(j, 8) '& Chr(124)
    
    a(j, 9) = Format(a(j, 9), "#,###.00")
    NrSpazi_I = Int(LunghMax - 1 - Int(Len(Trim(a(j, 9)))))
    If NrSpazi_I = -1 Then NrSpazi_I = NrSpazi_I + 1
    a(j, 9) = Space(NrSpazi_I) & a(j, 9) '& Chr(124)
    
    If a(j, 1) <> "" Then D(j) = Array(a(j, 1), a(j, 2), a(j, 3), a(j, 4), a(j, 5), a(j, 6), a(j, 7), a(j, 8), a(j, 9))
    Next j
    
    ' UserForm1.ListBox1.Clear
    UserForm1.ListBox1.List = Application.Transpose(Application.Transpose(D.items))
    
    'oppure
    ' UserForm1.ListBox1.List = Application.Index(a, indice, 0)
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    
    With UserForm1 'carico combobox1
          nIdxuno = .ComboBox1.ListIndex
          uriga = sh.Range("A" & Rows.Count).End(xlUp).row
           .ComboBox1.Clear
          For i = 2 To uriga
              .ComboBox1.AddItem sh.Cells(i, 1).Value
          Next i
          If nIdxuno <= .ComboBox1.ListCount Then
            .ComboBox1.ListIndex = nIdxuno
          End If
    End With
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
                   
    UserForm1.TextBox1 = ""
    UserForm1.TextBox2 = ""
    UserForm1.TextBox3 = ""
    UserForm1.TextBox4 = ""
    UserForm1.TextBox5 = ""
    UserForm1.TextBox6 = ""
    UserForm1.TextBox7 = ""
    
    M2 = Time 'assegnazione a D2 del tempo in chiusura (termine) macro
    TextBox9 = M2
    'TextBox12 = Time
    tempoimpiegato = Format(M2 - M1, "hh:mm:ss") ' Assegnazione a tempoimpiegato della differenza tra D2 e 'D1 e formattazione nel formato ora-minuti-secondi
    ' MsgBox "Tempo impiegato: " & tempoimpiegato   ' messaggio finale del tempo trascorso
    
    UserForm1.ComboBox1.SetFocus
    Cancel = True
    ListBox1.ListIndex = ComboBox1.ListIndex
    
    ' UserForm1.ComboBox1.SetFocus
    UserForm1.ComboBox1 = UserForm1.ComboBox1 + 1 'si spota alla riga successiva
    
    Application.DisplayAlerts = False
     wk.Save
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = screenUpdateState
    Application.DisplayStatusBar = statusBarState
    Application.Calculation = calcState
    Application.EnableEvents = eventsState
    ActiveSheet.DisplayPageBreaks = displayPageBreaksState
    
    Set sh = Nothing
    Set wk = Nothing
    
    End Sub

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi