Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 Criar guias, formatar e parar no último nome da lista.

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
Bruno_vnery



Mensagens : 1
Data de inscrição : 31/07/2012

MensagemAssunto: Criar guias, formatar e parar no último nome da lista.    Ter Jul 31, 2012 10:05 pm

Olá, pessoal. Sou novo por aqui e dei uma olhadinha nos outros tópicos para ver se encontrava algo que pudesse me ajudar, mas não consegui encontrar nada... se já tiver algo me desculpe a repetição.

Estou querendo fazer uma planilha para um clínica. Essa planilha tem uma relação com os cooperados, que dela fazem parte. A macro irá pegar essa lista, criar uma guia para cada um dos nomes, fazer a formatação das planilhas criadas e por fim criar uma outra planilha com os dados consolidados de quanto entrou pra cada cooperado, quanto entrou pra clínica... enfim.

Essa macro que está aqui está quase perfeita. Tem uma guia chamada "Cooperado", que é a lista base, que acaba assumindo a mesma formatação que as outras planilhas criadas... Só que não é pra assumir essa formatação e eu não sei como resolver.

Obrigado pela ajuda.
_______________________________________________________//_________________________________________________

Option Explicit

Private Sub Criarplanilha()
Dim strCol As String
Dim strRow As String
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strWsName As String
Dim strSrcName As String

On Error GoTo ErrHnd

'setup column letter and first row number containing names
'column
strCol = "A"
'row (number is in double quotes)
strRow = "1"

'turn off screen updating to stop flicker & increase speed
Application.ScreenUpdating = False

'save this worksheet's name, so we can go back to it later
strSrcName = ActiveSheet.Name

'set start of data in selected column
Set rngStart = ActiveSheet.Range(strCol & strRow)
'find end of data in selected column
Set rngEnd = ActiveSheet.Range(strCol & CStr(Application.Rows.Count)) _
.End(xlUp)

'loop through cells in used range
For Each rngCell In ActiveSheet.Range(rngStart, rngEnd)
'ignore empty cells in range
If rngCell.Text <> "" Then
'get worksheet name
strWsName = rngCell.Text
'test if worksheet exists
On Error Resume Next
If Worksheets(strWsName) Is Nothing Then
'worksheet does not exist
'reinstate error handling
On Error GoTo ErrHnd
'create new sheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
'name new sheet
Worksheets(Worksheets.Count).Name = strWsName
Else
'worksheet already exists
'reinstate error handling
On Error GoTo ErrHnd

End If
Call Formatarplanilha
End If
Next rngCell

'go back to the source worksheet
Worksheets(strSrcName).Activate

'reinstate screen updating
Application.ScreenUpdating = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'go back to the source worksheet
Worksheets(strSrcName).Activate
'reinstate screen updating
Application.ScreenUpdating = True

End Sub


Sub Formatarplanilha()

Call Criarplanilha

Range("A1").Select
ActiveCell.FormulaR1C1 = "Paciente"
Columns("A:A").ColumnWidth = 36.29
Range("B1").Select
Columns("B:B").ColumnWidth = 11.57
ActiveCell.FormulaR1C1 = "Data de " & Chr(10) & "pagamento"
Range("C1").Select
Columns("C:C").ColumnWidth = 10.86
ActiveCell.FormulaR1C1 = "Valor Pago" & Chr(10) & "(Paciente)"
Range("D1").Select
ActiveCell.FormulaR1C1 = "15% CBPS"
Range("E1").Select
Columns("E:E").ColumnWidth = 15.29
ActiveCell.FormulaR1C1 = "Valor Líquido" & Chr(10) & "(Cooperado)"
Range("B1:E1").Select
Range("A2:A30").Select
ActiveWorkbook.Names.Add Name:="Paciente", RefersToR1C1:= _
"=R2C1:R30C1"
Range("B2:B30").Select
ActiveWorkbook.Names.Add Name:="Data", RefersToR1C1:="=R2C2:R30C2"
Range("C2:C30").Select
ActiveWorkbook.Names.Add Name:="Vpac", RefersToR1C1:="=R2C3:R30C3"
Range("D2:D30").Select
ActiveWorkbook.Names.Add Name:="CBPS", RefersToR1C1:="=R2C4:R30C4"
Range("E2:E30").Select
ActiveWorkbook.Names.Add Name:="Vcoop", RefersToR1C1:="=R2C5:R30C5"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:E30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:E1").Select
Range("A1:E30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("Paciente").Select
Selection.Font.Bold = True
Range("Data").Select
Selection.NumberFormat = "m/d/yyyy"
Range("Vpac").Select
Selection.NumberFormat = "$ #,##0.00"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*15%"
Range("D2").Select
Selection.AutoFill Destination:=Range("CBPS"), Type:=xlFillDefault
Range("CBPS").Select
Selection.NumberFormat = "$ #,##0.00"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("E2").Select
Selection.AutoFill Destination:=Range("Vcoop"), Type:=xlFillDefault
Range("Vcoop").Select
Range("A1:E1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A2:E30").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(LIN()+1;2)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(LIN( );2)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
ActiveWindow.SmallScroll Down:=0

End Sub

Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Criar guias, formatar e parar no último nome da lista.    Dom Ago 05, 2012 3:46 pm

Bom dia!!

Quando postar use as as chaves de código [ seu código ].

Ta poluído demais.

Além de misturado essa parte seria sua alteração..
Código:
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:E30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:E1").Select
Range("A1:E30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("Paciente").Select
Selection.Font.Bold = True
Range("Data").Select
Selection.NumberFormat = "m/d/yyyy"
Range("Vpac").Select
Selection.NumberFormat = "$ #,##0.00"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*15%"
Range("D2").Select
Selection.AutoFill Destination:=Range("CBPS"), Type:=xlFillDefault
Range("CBPS").Select
Selection.NumberFormat = "$ #,##0.00"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
Range("E2").Select
Selection.AutoFill Destination:=Range("Vcoop"), Type:=xlFillDefault
Range("Vcoop").Select
Range("A1:E1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A2:E30").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(LIN()+1;2)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(LIN( );2)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
..porém recomendo gravar a maro só pra copiar os dados sem formatar.

Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
 
Criar guias, formatar e parar no último nome da lista.
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» Ajudem com inventario diferente???
» Tutorial Criar efeitos na Render
» Como criar e definir Photoshop Brushes
» TUTORIAL para criar widgets
» Tutorial: Criar ISO de Ps1.

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: