Basole

@Bianca Chagas  No arquivo Excel, na clouna "G" acrescente todos os endereços (caminho), das fotos que serão inseridas na apresentação do arquivo PowerPoint.

* Feche o arquivo do Excel

Para Executar a macro, no arquivo PowerPoint, aperte as teclas Alt+ F8, em seguida click 2 vezes na macro "MalaDiretaComExcel" e aguarde. 

MalaDiretaPPT.zip

@isabela queiroz se o que deseja copiar o que está abaixo de PN, ou seja a uma linha abaixo, utilize referenciando o endereço da linha e a respectiva coluna:

Cells(rngPN.Row+1, Coluna)

@isabela queiroz testei o codigo que modificou e está funcionando perfeitaemnte.

De qualquer forma alterei o codigo para copiar celula por celula. (* este processo pode demorar dependendo dos seus dados).

Acrescentei tambem o comando para ocultar a aba de exemplo. 

*Para o comando ocultar aba, funcione sem erro, precisa acrescentar antes, o comando para ativar uma outra aba que esteja visivel.

Salvar_Sheet_Novo_Arquivo.zip

@JorgeSouza coloque o prefixo VBA.  em todas funções:

Vba.Format

VBA.Ucase

VBA. DateAdd

@JorgeSouza acrescente VBA antes de date 

Vba.Date

@isabela queirozVeja se o exemplo atende

Salvar_Sheet_Novo_Arquivo.zip

Segue com as alterações

Exemplo_Numeracao_Automatica_Salvar-Docx.zip

Segue com as alterações

VBA CONFORME O DIA DA SEMANA APRESENTAR O NOME DO PROFESSOR - PERG.zip

@Luis Filipe Garrido pra mim não ficou muito claro a sua questão!

@GENECIOFICIAL veja se é isso

VBA CONFORME O DIA DA SEMANA APRESENTAR O NOME DO PROFESSOR - PERG.zip

Com vba é possível, mas é necessario analisar melhor a formatação do seu arquivo

Segue um exemplo generico: 

Sub LerImportarTXT()
    Dim fso         As Object
    Dim sourceFile  As Object
    Dim myFilePath  As String
    Dim myFileText  As String
    Dim LR!
    Dim line        As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    myFilePath = "C:\Temp\txt\Teste.txt" 'ALTERE O LOCAL E NOME DO ARQUIVO

    LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    Set sourceFile = fso.OpenTextFile(myFilePath, 1)
    If Not sourceFile.AtEndOfStream Then
        line = sourceFile.ReadLine

        With ActiveSheet
            .Cells(LR, 1) = VBA.Trim(VBA.Mid(line, 3, 13)) ' NOME: caractere 03 ate 15 (tamanho 13)
            .Cells(LR, 2) = VBA.Trim(VBA.Mid(line, 16, 15)) 'CIDADE: caractere 16 ate 30 (tamanho 15)
            .Cells(LR, 3) = VBA.Trim(VBA.Mid(line, 31, 5))  ' NUMERO DO PEDIDO: caractere 31 ate 35 (tamanho 5)
            .Cells(LR, 4) = VBA.Trim(VBA.Mid(line, 36, 1))  'ORDEM: caractere 36 (tamanho 1)
        End With
    End If
    sourceFile.Close
End Sub

Tente 

Range("H11").value = Range("H11").value * 1.01 

Para 1% e 

 * 1.005

para 0,5 %

@Andreza Santos

Fiz alterações na sub Inserir_Clientes

Sub Inserir_clientes()
    Dim tabela_clientes As ListObject
    Dim n           As Integer
    Dim id          As Integer
    Dim ws          As Worksheet

    Set ws = Sheets("Clientes")
    Set tabela_clientes = ws.ListObjects("Clientes")

    id = Range("ID").Value
    With tabela_clientes
        .ListRows.Add

        n = .DataBodyRange.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        .DataBodyRange(RowIndex:=n, columnindex:=1).Value = id
        .DataBodyRange(RowIndex:=n, columnindex:=2).Value = Sistema.txt_nome.Value
        .DataBodyRange(RowIndex:=n, columnindex:=3).Value = Sistema.cbb_sexo.Value
        .DataBodyRange(RowIndex:=n, columnindex:=4).Value = Sistema.txt_telefone.Value
        .DataBodyRange(RowIndex:=n, columnindex:=5).Value = Sistema.txt_cep.Value
        .DataBodyRange(RowIndex:=n, columnindex:=6).Value = Sistema.txt_endereco.Value
        .DataBodyRange(RowIndex:=n, columnindex:=7).Value = Sistema.txt_numero.Value
        .DataBodyRange(RowIndex:=n, columnindex:=8).Value = Sistema.txt_bairro.Value
        .DataBodyRange(RowIndex:=n, columnindex:=9).Value = Sistema.txt_local.Value

        Range("ID").Value = id + 1

        With Sistema
            .txt_nome.Text = ""
            .cbb_sexo.Text = ""
            .txt_telefone.Text = ""
            .txt_cep.Text = ""
            .txt_endereco.Text = ""
            .txt_numero.Text = ""
            .txt_bairro.Text = ""
            .txt_local.Text = ""
        End With


        Call Atualizar_listclientes

        MsgBox "Cadastrado com sucesso!", vbInformation, "Informação"

    End With
End Sub

*Caso o erro persista, tente deletar toda a tabela "Clientes" e inserir novamente.

@Andreza Santos sim eu fiz os testes tambem de cadastrar novos cilentes;

Adicionou novos registros na tabela clientes, sem problemas

Qual a versão do seu Excel (office) ? 

@Andreza Santos aqui pra mim só apareceu erro na hora de atualizar, na 

Sub Atualizar_listclientes

Fiz umas pequenas alterações, ai funcionou sem problemas:

Ficou assim:  

Sub Atualizar_listclientes()
    Dim tabela      As ListObject

    Set tabela = Worksheets("Clientes").ListObjects("Clientes")
    With Sistema.cbb_clientes
        .RowSource = ""
        .Clear
        .ColumnCount = 2
        .List = tabela.DataBodyRange.Value2
    End With
End Sub

@diego_janjao para criar uma pasta neste formato [ 01.Janeiro ], de acordo com a coluna "E", substitue

Esta linha:

 save = ThisWorkbook.Path & "\" & Format(Cells(Target.Row, 4).Value, "000000") & " - " & Cells(Target.Row, 8).Value & " - " & Cells(Target.Row, 11).Value

por esta:

save = ThisWorkbook.Path & "\" & VBA.Month(Cells(Target.Row, 5).Value) & "." & VBA.StrConv(VBA.MonthName(VBA.Month(Cells(Target.Row, 5).Value)), 3) 

@rosanezane boa tarde.

A macro do Midori funcionou aqui pra mim.

Chegou a testar?  

@rosanezane

No recurso da mala direta do Word, não encontrei nenhuma opção de agrupar novos documentos em um unico. 

A opção seria a de copiar e colar os docs criados individualmente em um unico documento, (como no exemplo do @Midori ), mas devido a dimensão dos dados, aqui pra mim, ao fazer isso as paginas não mantem a formatação original da Folha de Ponto, "pulando" para a pagina de baixo:

Outra opção é salvar todos os documentos individuais em pdf, em seguida, atraves de utilitário agrupa-los de acordo com cada empresa.

Estou ajustando a macro e mais tarde posto aqui. 

@EVA MONTEIRO de nada.

Atuatualizei a macro pois verifiquei um pequeno erro, pós alguns testes.

Segue o anexo.

atestado de saude ocupacional.zip

@EVA MONTEIRO bom dia 

Criei um menu com um botão para acionar a macro:

1 - Click na Tab superior: [suplementos] ....

2 - E do lado esquerdo, superior [Menu] e no botão [Macro Salvar ...]

3 - Abrirá uma janela perguntando em qual pasta deseja salvar os documento(s) pdf(s) que serão criados.

Veja se é isso que deseja.

Files.zip

@vigue se o problema for com o caminho longo (com + de 255 caracteres), tente usar a função que encurta o path:

Sub SalvaCopia()

Dim ToPath As String
ToPath = "\\endereco.sharepoint.com\sites\teste\Documentos Compartilhados\pasta backup"
Nome_backup = "planilha backup.xlsm"

ActiveWorkbook.SaveCopyAs Filename:= _
GetShortPath(ToPath & "\Backups da conferencia diaria\" & Nome_backup)

End Sub

Public Function GetShortPath(path As String) As String
' função que encurta o caminho(path), abaixo limite 256 caract.
  Dim fso As Object
  If fso Is Nothing Then
  Set fso = VBA.CreateObject("Scripting.FileSystemObject")
  End If
 
  If fso.FileExists(path) Then
      GetShortPath = fso.GetFile(path).ShortPath
      Exit Function
  End If
 
  If fso.FolderExists(path) Then
      GetShortPath = fso.GetFolder(path).ShortPath
      Exit Function
  End If
  
End Function

@EVA MONTEIRO sim envie os arquivos para ajustar e testar a(s) macro(s)

@rosanezane eu entendi que cada FOLHA DE FREQUÊNCIA FUNCIONAL de funcionários da MESMA EMPRESA, seja salvo em um unico documento no formato PDF.

Seria isso? 

2 horas atrás, marcospires1 disse:

Sem querer abusar, um dos campos é data e causa erro na macro, sabe como posso corrigir?

Visto que a data vai ser inserida por outras pessoas utilizando este arquivo.

@marcospires1 bom considerando que a data esteja na celula A1 segue exemplo: 

With ActiveSheet

LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & VBA.Format(.[A1], "dd-mm-yyyy") & .[K2] & .[G5] & ".pdf"

End With

Pode-se tambem alterar a formatação da data colocando ao contrario, ou seja ano-mes-dia 

LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & VBA.Format(.[A1], "yyyy-mm-dd") & .[K2] & .[G5] & ".pdf"

Desculpe faltou uns detalhes: 

With ActiveSheet

LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & .[A1] & .[K2] & .[G5] & ".pdf"

End With

* Certifique-se que nas celulas A1, K2 e G5,  tenham dados referentes ao nome do arquivo que será salvo.