You are here:---Rispondi a: [RISOLTO] Aggiunta di dati tramite macro per tabella Excel
Rispondi a: [RISOLTO] Aggiunta di dati tramite macro per tabella Excel 2018-11-09T17:54:15+00:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Aggiunta di dati tramite macro per tabella Excel Rispondi a: [RISOLTO] Aggiunta di dati tramite macro per tabella Excel

antinoantino
Partecipante
    Post totali: 25

    Ciao Sid,
    Ho modificato la macro che mi hai mandato e per quanto riguarda la larghezza della colonna “C” tutto OK, mentre non sono riuscito a sistemare l’altezza delle righe del report e la centratura dei dati nella colonna “Costo”.
    Questa è la macro con le modifiche apportate:

    Sub crea_report2() ‘SITUAZIONE FATTURAZIONE CLIENTI
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ultC As Long, j As Long
    Dim riga As Long, riga2 As Long
    Dim Ws As Worksheet
    Dim aperto As Boolean
    Dim jj As Long
    Dim aBordi As Variant
    aBordi = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)

    ‘VERIFICO SE IL FILE “Schede Clienti.xlsm” è APERTO
    For Each wb In Application.Workbooks
    If wb.Name = “SCHEDE CLIENTI.xlsm” Then
    aperto = True
    Set wb1 = Workbooks(“SCHEDE CLIENTI.xlsm”)
    Exit For
    End If
    Next wb

    ‘SE è CHIUSO LO APRO
    If Not aperto Then
    Set wb1 = Workbooks.Open(“C:\FATTURAZIONE\SCHEDE CLIENTI.xlsm”)
    End If

    ‘Set wb1 = Workbooks(“Schede Clienti.xlsm”)
    Set wb2 = Workbooks.Add
    riga = 3
    riga2 = riga + 1

    ‘ On Error GoTo uscita
    ‘FORMATTO IL FOGLIO1 DEL NUOVO FILE
    With wb2.Sheets(“Foglio1”)
    .Range(“A1”).Value = “SITUAZIONE FATTURAZIONE CLIENTI AL ” & Date
    With .Range(“A1:D1”)
    .Borders.Weight = xlMedium
    .Borders.LineStyle = xlContinuous
    .Merge
    .HorizontalAlignment = xlCenter
    .Font.Bold = True
    End With
    .Range(“A2”).Value = “CLIENTE”
    .Range(“B2”).Value = “ULTIMO PERIODO FATTURATO”
    .Range(“C2”).Value = “PERIODO DA FATTURARE”
    .Range(“D2”).Value = “COSTO”
    .Rows(1).RowHeight = 25
    With .Range(“A2:D2”)
    .HorizontalAlignment = xlCenter
    .Font.Bold = True
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlMedium
    End With
    End With

    ‘CICLO I FOGLI DEL FILE PRINCIPALE
    For Each Ws In wb1.Worksheets
    With wb1.Sheets(Ws.Name)
    ultC = IIf(.Range(“C3”).Value = “”, 3 _
    , .Range(“C” & Rows.Count).End(xlUp).Row)
    With wb2.Sheets(“Foglio1”)

    ‘INSERIMENTO DATI
    .Range(“A” & riga).Value = wb1.Sheets(Ws.Name).Range(“A1”).Value
    If wb1.Sheets(Ws.Name).Range(“C3”) = “” Then
    With .Range(“B” & riga)
    .Value = “MAI FATTURATO”
    ‘.Interior.ColorIndex = 3 ‘colore fondo cella
    ‘.Font.ColorIndex = 2 ‘ colore carattere
    End With
    Else
    .Range(“B” & riga).Value = wb1.Sheets(Ws.Name).Range(“C” & ultC).Value
    End If
    .Range(“D” & riga).Value = wb1.Sheets(Ws.Name).Range(“h1”).Value ‘COSTO
    riga = riga + 1
    End With
    End With
    Next Ws

    ‘CHIUDO IL FILE “SCHEDE_CLIENTI.xlsm”
    wb1.Close

    ‘ADATTO LA LARGHEZZA DELLE COLONNE.
    ‘SELEZIONO IL TITOLO.
    ‘ADATTO I MARGINI PER LA STAMPA

    With wb2.Sheets(“Foglio1”)
    ‘.Columns(“A:D”).AutoFit
    .Columns(“A”).AutoFit
    .Columns(“B”).AutoFit
    .Columns(“C”).ColumnWidth = 62
    .Columns(“D”).AutoFit
    .Range(“A1:D1”).Select
    ‘End With
    With .PageSetup
    .LeftMargin = Application.InchesToPoints(0.26)
    .RightMargin = Application.InchesToPoints(0.34)
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .Orientation = xlLandscape ‘ foglio orizzontale
    End With

    ‘Ordinamento database
    .Sort.SortFields.Add Key:=.Range(“A3:A300”) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
    .SetRange wb2.Sheets(“Foglio1”).Range(“A2:D300”)
    .Header = xlYes
    .MatchCase = False
    .SortMethod = xlPinYin
    .Apply
    End With

    ‘INSERIMENTO DOPPIA RIGA, BORDI E FONDO ROSSO
    For j = riga – 1 To riga2 Step -1
    .Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For jj = LBound(aBordi) To UBound(aBordi)
    With .Range(“A” & j + 1 & “:D” & j + 2).Borders(aBordi(jj))
    .LineStyle = xlContinuous
    .Weight = xlMedium
    End With
    Next jj
    With .Range(“B” & j + 1)
    If .Value = “MAI FATTURATO” Then
    .Interior.ColorIndex = 3 ‘colore fondo cella
    .Font.ColorIndex = 2 ‘ colore carattere
    End If
    End With
    Next j

    For jj = LBound(aBordi) To UBound(aBordi)
    With .Range(“A3:D4”).Borders(aBordi(jj))
    .LineStyle = xlContinuous
    .Weight = xlMedium
    End With
    Next jj
    With .Range(“B3”)
    If .Value = “MAI FATTURATO” Then
    .Interior.ColorIndex = 3 ‘colore fondo cella
    .Font.ColorIndex = 2 ‘ colore carattere
    End If
    End With
    End With
    Set wb1 = Nothing
    Set wb2 = Nothing

    Application.ScreenUpdating = True
    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