' Adiciona a fórmula para o vencimento todo dia 10
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Formula = "=IF(DAY(TODAY())>10, TODAY()+30-DAY(TODAY())+10, DATE(YEAR(TODAY()), MONTH(TODAY())-1+" & i - 1 & ", 10))"
Next i
' Adiciona valores aleatórios para os débitos
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=RAND()*100"
Next i
' Adiciona a soma total
tabelaDebitos.ListColumns(14).DataBodyRange.Formula = "=SUM(B2:M2)"
tabelaDebitos.ListColumns(14).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=SUM(B3:M4)"
' Adiciona a fórmula para os dias em atraso
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 1).Resize(3, 1).Formula = "=IF(TODAY()>" & Chr(64 + i) & "2, TODAY()-" & Chr(64 + i) & "2, 0)"
Next i
' Adiciona o gráfico de Gantt
Set chartSheet = Charts.Add
chartSheet.ChartType = xlBarStacked
chartSheet.SetSourceData Source:=tabelaDebitos.ListColumns("Total").DataBodyRange, PlotBy:=xlColumns
chartSheet.SeriesCollection(1).XValues = tabelaDebitos.ListColumns(1).DataBodyRange.Offset(1, 0).Resize(3, 1)
chartSheet.SeriesCollection(1).Name = "Débitos"
' Adiciona formatação ao gráfico
chartSheet.HasTitle = True
chartSheet.ChartTitle.Text = "Saúde Financeira do Condomínio"
chartSheet.Axes(xlCategory, xlPrimary).HasTitle = True
chartSheet.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Clientes"
chartSheet.Axes(xlValue, xlPrimary).HasTitle = True
chartSheet.Axes(xlValue, xlPrimary).AxisTitle.Text = "Débitos"
End Sub
Sub CriarPastaTrabalho()
Dim ws As Worksheet
Dim tabelaDebitos As ListObject
Dim chartSheet As Chart
Dim i As Integer
' Cria uma nova planilha
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Condominio"
' Adiciona a fórmula para o vencimento todo dia 10
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Formula = "=IF(DAY(TODAY())>10, TODAY()+30-DAY(TODAY())+10, DATE(YEAR(TODAY()), MONTH(TODAY())-1+" & i - 1 & ", 10))"
Next i
' Adiciona valores aleatórios para os débitos
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=RAND()*100"
Next i
' Adiciona a soma total
tabelaDebitos.ListColumns(14).DataBodyRange.Formula = "=SUM(B2:M2)"
tabelaDebitos.ListColumns(14).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=SUM(B3:M4)"
' Adiciona a fórmula para os dias em atraso
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 1).Resize(3, 1).Formula = "=IF(TODAY()>" & Chr(64 + i) & "2, TODAY()-" & Chr(64 + i) & "2, 0)"
Next i
' Adiciona o gráfico de Gantt
Set chartSheet = Charts.Add
chartSheet.ChartType = xlBarStacked
chartSheet.SetSourceData Source:=tabelaDebitos.ListColumns("Total").DataBodyRange, PlotBy:=xlColumns
chartSheet.SeriesCollection(1).XValues = tabelaDebitos.ListColumns(1).DataBodyRange.Offset(1, 0).Resize(3, 1)
chartSheet.SeriesCollection(1).Name = "Débitos"
' Adiciona formatação ao gráfico
chartSheet.HasTitle = True
chartSheet.ChartTitle.Text = "Saúde Financeira do Condomínio"
chartSheet.Axes(xlCategory, xlPrimary).HasTitle = True
chartSheet.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Clientes"
chartSheet.Axes(xlValue, xlPrimary).HasTitle = True
chartSheet.Axes(xlValue, xlPrimary).AxisTitle.Text = "Débitos"
End Sub
Pergunta
Alessandro Gomes de Sousa
Não consigo corrigir este código, Alguém pode me ajudar?
Sub CriarPastaTrabalho()
Dim ws As Worksheet
Dim tabelaDebitos As ListObject
Dim chartSheet As Chart
Dim i As Integer
' Cria uma nova planilha
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Condominio"
' Adiciona a tabela de débitos
Set tabelaDebitos = ws.ListObjects.Add(xlSrcRange, ws.Range("A1:M4"), , xlYes)
tabelaDebitos.Name = "TabelaDebitos"
tabelaDebitos.HeaderRowRange.Value = Array("Cliente", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "Total", "DiasAtraso")
' Adiciona os clientes
tabelaDebitos.ListColumns(1).DataBodyRange.Value = Array("Cliente 1", "Cliente 2", "Cliente 3")
' Adiciona a fórmula para o vencimento todo dia 10
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Formula = "=IF(DAY(TODAY())>10, TODAY()+30-DAY(TODAY())+10, DATE(YEAR(TODAY()), MONTH(TODAY())-1+" & i - 1 & ", 10))"
Next i
' Adiciona valores aleatórios para os débitos
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=RAND()*100"
Next i
' Adiciona a soma total
tabelaDebitos.ListColumns(14).DataBodyRange.Formula = "=SUM(B2:M2)"
tabelaDebitos.ListColumns(14).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=SUM(B3:M4)"
' Adiciona a fórmula para os dias em atraso
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 1).Resize(3, 1).Formula = "=IF(TODAY()>" & Chr(64 + i) & "2, TODAY()-" & Chr(64 + i) & "2, 0)"
Next i
' Adiciona o gráfico de Gantt
Set chartSheet = Charts.Add
chartSheet.ChartType = xlBarStacked
chartSheet.SetSourceData Source:=tabelaDebitos.ListColumns("Total").DataBodyRange, PlotBy:=xlColumns
chartSheet.SeriesCollection(1).XValues = tabelaDebitos.ListColumns(1).DataBodyRange.Offset(1, 0).Resize(3, 1)
chartSheet.SeriesCollection(1).Name = "Débitos"
' Adiciona formatação ao gráfico
chartSheet.HasTitle = True
chartSheet.ChartTitle.Text = "Saúde Financeira do Condomínio"
chartSheet.Axes(xlCategory, xlPrimary).HasTitle = True
chartSheet.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Clientes"
chartSheet.Axes(xlValue, xlPrimary).HasTitle = True
chartSheet.Axes(xlValue, xlPrimary).AxisTitle.Text = "Débitos"
End Sub
Sub CriarPastaTrabalho()
Dim ws As Worksheet
Dim tabelaDebitos As ListObject
Dim chartSheet As Chart
Dim i As Integer
' Cria uma nova planilha
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Condominio"
' Adiciona a tabela de débitos
Set tabelaDebitos = ws.ListObjects.Add(xlSrcRange, ws.Range("A1:M4"), , xlYes)
tabelaDebitos.Name = "TabelaDebitos"
tabelaDebitos.HeaderRowRange.Value = Array("Cliente", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "Total", "DiasAtraso")
' Adiciona os clientes
tabelaDebitos.ListColumns(1).DataBodyRange.Value = Array("Cliente 1", "Cliente 2", "Cliente 3")
' Adiciona a fórmula para o vencimento todo dia 10
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Formula = "=IF(DAY(TODAY())>10, TODAY()+30-DAY(TODAY())+10, DATE(YEAR(TODAY()), MONTH(TODAY())-1+" & i - 1 & ", 10))"
Next i
' Adiciona valores aleatórios para os débitos
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=RAND()*100"
Next i
' Adiciona a soma total
tabelaDebitos.ListColumns(14).DataBodyRange.Formula = "=SUM(B2:M2)"
tabelaDebitos.ListColumns(14).DataBodyRange.Offset(1, 0).Resize(3, 1).Formula = "=SUM(B3:M4)"
' Adiciona a fórmula para os dias em atraso
For i = 2 To 13
tabelaDebitos.ListColumns(i).DataBodyRange.Offset(1, 1).Resize(3, 1).Formula = "=IF(TODAY()>" & Chr(64 + i) & "2, TODAY()-" & Chr(64 + i) & "2, 0)"
Next i
' Adiciona o gráfico de Gantt
Set chartSheet = Charts.Add
chartSheet.ChartType = xlBarStacked
chartSheet.SetSourceData Source:=tabelaDebitos.ListColumns("Total").DataBodyRange, PlotBy:=xlColumns
chartSheet.SeriesCollection(1).XValues = tabelaDebitos.ListColumns(1).DataBodyRange.Offset(1, 0).Resize(3, 1)
chartSheet.SeriesCollection(1).Name = "Débitos"
' Adiciona formatação ao gráfico
chartSheet.HasTitle = True
chartSheet.ChartTitle.Text = "Saúde Financeira do Condomínio"
chartSheet.Axes(xlCategory, xlPrimary).HasTitle = True
chartSheet.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Clientes"
chartSheet.Axes(xlValue, xlPrimary).HasTitle = True
chartSheet.Axes(xlValue, xlPrimary).AxisTitle.Text = "Débitos"
End Sub
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.