Coleção 15.000 Macros MS Excel VBA

   Mega_Colecao Macros de Macros MS Excel VBA
      

Curso Completo MS Excel VBA

Excel VBA Video Aulas

 Aprenda Excel VBA - SaberExcel VBA - Video Aulas       
Com Simplicidade e Facilidade,
Escrevendo menos e fazendo mais
Linha de raciocínio de fácil entendimento...

 

20.000 Planilhas MS Excel VBA

 20.000 Planilhas Microsoft Excel VBA, treinamentos, busca, pesquisas, desenvolvimento a partir de exemplos prontos, estudos e pratica com planilhas prontas.

SBI Excel VBA centro espirita seguidores dia semana

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Este Macro do Aplicativo Microsoft Excel VBA(Visual Basic Application),  vai distribuir os frequentadores de uma determinada casa de oração (denominação Espírita), a pedido dos organizadores que precisam de uma planilha
para fazer uma chamada de presença, mas precisam que o banco de dados sejam distribuidos nos dias de acordo
com a escolha, e também cada planilha(dia-semana), ficar pronta também para a impressão, onde fizemos uma macro para formatar a impressão,uma boa planilha pra nosso treinamento com VBA Excel - Escola Saberexcel VBA Estudos.
disposta na area Livre.   (Seja um assinante Escola Saberexcel VBA Estudos®)

Procedimentos de Aquisição dos produtos Didáticos SaberExcel

Prezado Sr. Marcondes,
Precisamos de sua ajuda, para confeccionarmos uma planilha.
Frequentamos um local de oração denominação "Espírita" onde várias pessoas frequentam em busca de
cura, porém, são dois dias na semana, (Terça e Quinta). Solicitamos se possível nos ajudar com esse trabalho,
caso haja custo estamos dispostos a pagar.

RESPOSTA: Planilha pronta.
há como fazer sim, faremos um banco de dados de todos os frequentadores, depois em uma primeira Linha
vamos inserir os dias no mês que ocorrerão as reuniões, após isso,  é só escolher o dia de da semana
que cada um frequenta e executar o macro, o código vai distribuir nas folhas de planilhas os frequentadores
referente ao dia da semana.

Fique com Deus,
Expedito Marcondes
Escola Saberexcel VBA Estudos®
(para os estudiosos do VBA a planilha está disposta no final da página)

 '//================'

Sub sbx_copiar_criterio()
Dim tLin, qLin As Integer
tLin = 2: t = 1
qLin = 2: q = 1
Plan1.Unprotect
Plan2.Unprotect
'Impressao_cabecalho_insere
x = Plan3.Cells(Rows.Count, "b").End(xlUp).Row
Plan1.Range(Plan1.Cells(1, "a"), Plan1.Cells(x, "f")).Clear
Plan2.Range(Plan2.Cells(1, "a"), Plan2.Cells(x, "f")).Clear
Plan3.Range(Plan3.Cells(1, "b"), Plan3.Cells(1, "f")).Copy Plan1.Cells(1, "a")
Plan3.Range(Plan3.Cells(1, "b"), Plan3.Cells(1, "f")).Copy Plan2.Cells(1, "a")
Plan1.Range(Plan1.Cells(1, "b"), Plan1.Cells(1, "f")).Font.Bold = True
Plan2.Range(Plan2.Cells(1, "b"), Plan2.Cells(1, "f")).Font.Bold = True
'ordenar dados na planilha plan3
Plan3.Range("B1" & ":B" & x).Sort Key1:=Plan3.Range("B2"), order1:=xlAscending, Header:=xlYes
'instrução for next para fazer o laço em todas as linhas na plan3
For i = 2 To Plan3.Cells(Rows.Count, "b").End(xlUp).Row
 Cells(i, "b").Select  'selecionando sem necessidade só para ver o evento selecionar
    If Plan3.Cells(i, "g").Value = Plan3.[K1].Value Then
       Plan3.Cells(i, "b").Resize(, 5).Copy Plan1.Cells(tLin, "a")
       If t = 20 Then ' variavel para identificar somente 20 linhas para copiar o cabeçalho
          Plan3.Range(Plan3.Cells(1, "b"), Plan3.Cells(1, "f")).Copy Plan1.Cells(tLin, "a") 'copiando e colando
          Plan1.Range(Plan1.Cells(tLin, "a"), Plan1.Cells(tLin, "e")).Font.Bold = True 'negrito cabeçalho
          t = 0  'zerando a variavel t para iniciar com novo número (dentro do if) se for = 20
       End If
       t = t + 1  'incrementando a variavel + 1
       tLin = tLin + 1 'variavel tLin para incrementar as linhas de terça feira
       ct = ct + 1     'contador
    Else
       Plan3.Cells(i, "b").Resize(, 5).Copy Plan2.Cells(qLin, "a")
       If q = 20 Then
          Plan3.Range(Plan3.Cells(1, "b"), Plan3.Cells(1, "f")).Copy Plan2.Cells(qLin, "a")
          Plan2.Range(Plan2.Cells(qLin, "a"), Plan2.Cells(qLin, "e")).Font.Bold = True
          q = 0
       End If
       qLin = qLin + 1
       q = q + 1
       ct2 = ct2 + 1
    End If
 Next i
 x = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
 y = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
 Plan1.Range(Plan1.Cells(1, "a"), Plan1.Cells(x, "e")).Borders.LineStyle = 1
 Plan2.Range(Plan2.Cells(1, "a"), Plan2.Cells(y, "e")).Borders.LineStyle = 1
 Plan1.Range(Plan1.Cells(1, "a"), Plan1.Cells(x, "d")).RowHeight = 23.25
 Plan2.Range(Plan2.Cells(1, "a"), Plan2.Cells(y, "d")).RowHeight = 23.25
 Plan3.[m1].Value = ct
 Plan3.[m2].Value = ct2
 Plan1.Protect
 Plan2.Protect
 MsgBox "Trabalho de distribuição dos nomes realizados com sucesso!", vbInformation, "Grupo Espirita Paz e Amor"
 [H1].Select
End Sub

'//=============='

 '//===== FORMATANDO IMPRESSÃO CABEÇALHO E RODÁPÉ

Sub sby_impressao_cabecalho_insere()
With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
       
        .LeftHeader = "AMOR"
        .CenterHeader = "CASA DE ESTUDOS ESPÍRITA VERDADE E LUZ"
        .RightHeader = "VERDADE"
        .LeftFooter = "LUZ"
        .CenterFooter = "Caridade"
        .RightFooter = "Leia Lucas 16, 19:31"
       
        .LeftMargin = Application.InchesToPoints(0.787401575)
        .RightMargin = Application.InchesToPoints(0.787401575)
        .TopMargin = Application.InchesToPoints(0.984251969)
        .BottomMargin = Application.InchesToPoints(0.984251969)
        .HeaderMargin = Application.InchesToPoints(0.4921259845)
        .FooterMargin = Application.InchesToPoints(0.4921259845)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        '.PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    'mostrar impressao
    ActiveWindow.SelectedSheets.PrintPreview
End Sub

Sub sby_shapes_ajuda()
If Plan3.Shapes("Sbx_01").Visible = True Then
   Plan3.Shapes("Sbx_01").Visible = False
Else
   Plan3.Shapes("Sbx_01").Visible = True
End If
End Sub

Sub sby_limpar_teste()
Plan1.Unprotect
Plan2.Unprotect
'Impressao_cabecalho_insere
x = Plan3.Cells(Rows.Count, "b").End(xlUp).Row
Plan1.Range(Plan1.Cells(1, "a"), Plan1.Cells(x, "f")).Clear
Plan2.Range(Plan2.Cells(1, "a"), Plan2.Cells(x, "f")).Clear
Plan1.Protect
Plan1.Protect
MsgBox "Os dados das planilhas [ " & Plan1.Name & "]  e a Planilha [ " & Plan2.Name & " ]" & vbCrLf & _
       "Foram deletadas com sucessos"
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos
Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.




 u - Procedimentos de Aquisição dos produtos Didáticos SaberExcel
 Baixe o exemplo de planilha contendo os macros acima:
icon SBI Excel VBA centro espirita seguidores dia semana (70.29 kB)
  

Você está aqui: Home Excel VBA - Dicas Livre Excel VBA - Dicas Livre Excel VBA - Datas SBI Excel VBA centro espirita seguidores dia semana