Marcus Nagel_758472

É uma textbox? ou uma célula normal?

 

Se for uma célula não é necessário código.

Clique na célula que irá receber os dados de CPF, clique com o botão direito e vá em 'Formatar células...'

Abrirá a janela de personalização. Nela vamos navegar até a guia 'Personalizado' no lado esquerdo e em 'tipo:' cole o código ##".""A"###"."####-#

 

 

Pessoal, boa tarde.

 

Uma ajuda que acho que vocês vão matar rapidinho.

 

Tenho um formulário que posso tanto inserir dados numa base quanto puxar informações de um contrato da base que fica no mesmo arquivo.

Tudo esta funcionando perfeitamente, apenas não consigo formatar as datas como "dd/mm/yy".

 

Já tentei o "TextBox10 = Format (Date, "dd/mm/yy")" mas isso não altera nada.

Esse TextBox esta com a seguinte private sub para aceitar apenas números e "/" quando o usuário for digitar:

Private Sub TextBox11_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim strValid As String
    
TextBox11.MaxLength = 8
strValid = "0123456789/"
    If InStr(strValid, Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
    End If
       
End Sub

 

Quando eu peço para puxar os dados, o campo do TextBox vem como números, por exemplo:

Campo na base: 12/12/89

TextBox: 32854

 

Conseguem me ajudar a deixar o TextBox no mesmo formato da base?

Desde já MUITO OBRIGADO!

Gestão de Rotina v4.zip

RESOLVIDO!!

 

Troquei a variável Integer por Double. 

Long não servia.

 

Segue a planilha zipada e corrigida para caso alguém um dia precise de um arquivo parecido.

Gestão de Rotina v2.zip

Pessoal, bom dia.

 

Procurei bastante antes de vir aqui, mas as soluções que achei não me ajudaram. Espero que vocês consigam!!! 

 

Tenho uma planilha com alguns códigos em VBA que criam, pesquisam e atualizam uma base de dados no mesmo arquivo.

O campo obrigatório é o "Contrato", por ele eu consigo pesquisar ou atualizar algum contrato que tenha na base.

Até ai tudo esta funcionando corretamente, porém se eu coloco um contrato com 10 números (ex. 9000008400, que é o formato que vou usar) e clico em PESQUISAR ele informa o erro "Estouro" (apenas no PESQUISAR os outros "botões" funcionam normalmente). Pesquisei na internet e vi que podia ser por causa da variável Integer, mas já alterei para Long e o erro persiste.

 

Conseguem me ajudar a resolver???

 

Desde já, muito obrigado!!!

E um feliz ano novo para todos!

Gestão de Rotina v2.zip

@CasaDoHardware

 

Com sua ajuda consegui fazer o que queria!

Usei apenas a primeira macro com algumas ideias de modificação que você deu! 

MUITO OBRIGADO!!!

 

Segue o código para alguem se precisar.

Divide a planilha com base no Fornecedor e salva na pasta de cada Fornecedor no sharepoint.

 

Sub aExportParaSharepoint()

Dim Folder As String
Dim Caminho As String
Dim Fornecedor As String
Dim FSO As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset, rs2 As DAO.Recordset
Dim c As Long


Application.DisplayAlerts = False

Set FSO = CreateObject("Scripting.FileSystemObject")
Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")
While Not rs.EOF
    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
    Workbooks.Add
        For c = 0 To rs2.Fields.Count - 1
            Cells(1, c + 1) = rs2.Fields(c).Name
        Next

Caminho = "\\mysite\sites\gpss\mro\teste\" 'troque pelo caminho da pasta do sharepoint
Fornecedor = rs(0) & "\" 'pega o fornecedor e complementa o Caminho

Let Folder = Caminho & Fornecedor 'Caminho completo

Range("A2").CopyFromRecordset rs2
    Range("A:A").TextToColumns
    Range("A:A").NumberFormat = "dd/mm/yyyy"
    Range("P:P").NumberFormat = "dd/mm/yyyy"
    Range("A:AZ").EntireColumn.AutoFit
    Range("A1:C1").Interior.Color = RGB(228, 31, 43)
    Range("a1:c1").Font.ColorIndex = 2
    Range("A1:C1").Font.Bold = True
    ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0) 'salva na pasta com data e o nome do fornecedor

        rs.MoveNext
Wend

For Each File In FSO.GetFolder(Folder).Files
    Kill File
Next

End Sub

 

@CasaDoHardware

Boa valeu!!

 

Vou testar amanhã! E aviso aqui se deu certo!

 

Obrigado!

@CasaDoHardware

Tem como 

esse C:\Users\marcur09\Desktop\A\ & Arq & ".xlsx" mostrar a data atual e o nome do fornecedor? Se fizer isso já vai ser top!!!!

 

Exemplo: Fornecedor Abecom

C:\Users\marcur09\Desktop\A\Format(Date, "dd-mm-yyyy") & " " & Arq & ".xlsx"

Ai aparece:

C:\Users\marcur09\Desktop\A\24-02-2016 Abecom.xlsx

 

E outra pergunta. Como faço para exportar para o site mostrado na aba [base_dados]?

@CasaDoHardware

 

Se o nome dos arquivos não fosse dinamico poderia usar essa sim.

 

Acontece que o nome do arquivo muda conforme o dia que for executado.

@CasaDoHardware

Sub a02EnviarEmails()

Dim Folder As String, Recipient As String, Recipient2 As String
Dim FSO As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset, rs2 As DAO.Recordset
Dim c As Long


Application.DisplayAlerts = False

Folder = "C:\Users\marcur09\Desktop\A\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")


For Each File In FSO.GetFolder(Folder).Files
    Kill File
Next

While Not rs.EOF
    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
    Workbooks.Add
        For c = 0 To rs2.Fields.Count - 1
            Cells(1, c + 1) = rs2.Fields(c).Name
        Next
    Range("A2").CopyFromRecordset rs2
    Range("A:A").TextToColumns
    Range("A:A").NumberFormat = "dd/mm/yyyy"
    Range("P:P").NumberFormat = "dd/mm/yyyy"
    Range("A:AZ").EntireColumn.AutoFit
    ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0)
''''''''''''''''' Pegar esse arquivo salvo acima e exportar para o sharepoint''''''''''''''''''


        rs.MoveNext
Wend

End Sub

No código acima coloquei uma linha "Pegar esse arquivo salvo acima e exportar para o sharepoint", para dar uma ideia do que preciso.

@CasaDoHardware

 

Sub tst()

Const sSource As String = "C:\Users\marcur09\Desktop\A\3M.xlsx" 'change to suit

With CreateObject("WScript.Network")

Essa parte "Const sSource ........... \Desktop\A\3M.xlsx."

A parte em negrito eu teria que mudar manualmente, pois ela é o arquivo que desejo exportar. O problema é que quando rodo a primeira macro, ela salva o arquivo como (exemplo) 24-02-2016 3M.xlsx e o nome deve ser exatamente o mesmo para a segunda macro funcionar.

 

Precisava de algo que faça com que na primeira macro ele salve o arquivo e já exporte para o sharepoint, sem ser necessário a segunda macro.

 

Macro:

 

Separar Fornecedor -> Salvar um arquivo para cada fornecedor -> exportar cada fornecedor para sua pasta no sharepoint ( de acordo com a coluna "Site Sharepoint" da aba "banco_dados" do arquivo inicial)

 

 

Se ficar mais fácil, a primeira macro pode ser alterada.

@CasaDoHardware Desculpe, escrevi meio apressado.

 

A primeira macro (a02EnviarEmails) divide o arquivo por fornecedor, cria um arquivo diferente para cada um desses fornecedores e coloca a data que foi executada. Ex: 23-02-2016 3M.xlsx

Preciso de uma macro que pegue esses arquivos que estão numa pasta no drive C e export para o sharepoint indicado na aba "banco_dados", coluna "Site Sharepoint". 

 

Por exemplo:

 

o arquivo 3M tem que ser exportado para a pasta "https://sharepoint/mysite/3M".

o arquvio Abecom para "https://sharepoint/mysite/Abecom".

e por ai vai.....

 

A segunda macro (tst) exporta o arquivo para o local certo, porém preciso copiar e colar varias vezes, pois ela serve apenas para um fornecedor. E devido a data que a macro "a02EnviarEmails" coloca no nome do arquivo, teria que entrar e mudar todas as vezes que for utilizar.

 

Acho que agora deu para explicar.

 

[RESOLVIDO!!!!]

 

Boa noite pessoal.

 

Preciso de uma ajudinha para ajustar uma macro. Hoje ela separa as informações por fornecedor e cria um arquivo dentro de uma pasta no C: para cada fornecedor.

Tenho uma planilha com algumas informações entre elas Fornecedor Agrupado.

Em outra aba tenho essa mesma coluna Fornecedor Agrupado e a coluna Site Sharepoint, onde contem o caminho que quero exportar o arquivo de cada fornecedor. Cada fornecedor possui um caminho diferente.

 

Tenho os dois códigos a seguir:

Sub a02EnviarEmails()

Dim Folder As String, Recipient As String, Recipient2 As String
Dim FSO As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset, rs2 As DAO.Recordset
Dim c As Long


Application.DisplayAlerts = False

Folder = "C:\Users\marcur09\Desktop\A\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")
Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")


For Each File In FSO.GetFolder(Folder).Files
    Kill File
Next

While Not rs.EOF
    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")
    Workbooks.Add
        For c = 0 To rs2.Fields.Count - 1
            Cells(1, c + 1) = rs2.Fields(c).Name
        Next
    Range("A2").CopyFromRecordset rs2
    Range("A:A").TextToColumns
    Range("A:A").NumberFormat = "dd/mm/yyyy"
    Range("P:P").NumberFormat = "dd/mm/yyyy"
    Range("A:AZ").EntireColumn.AutoFit
    ActiveWorkbook.Close True, Folder & Format(Date, "dd-mm-yyyy") & " " & rs(0)
        rs.MoveNext
Wend

End Sub

Sub tst()

Const sSource As String = "C:\Users\marcur09\Desktop\A\3M.xlsx" 'change to suit

With CreateObject("WScript.Network")

.MapNetworkDrive "T:", "\\team.braskem.com.br\sites\gpss\mro\Produtividade\_Marcus\teste\3M" 'change to suit
If Len(Dir(sSource)) Then CreateObject("Scripting.FileSystemObject").copyfile sSource, "T:\"
Application.Wait Now + TimeSerial(0, 0, 3)

On Error Resume Next
.RemoveNetworkDrive "T:"
On Error GoTo 0

End With

End Sub

 

Conseguem me ajudar???

 

OBRIGADO!!!

Teste 1 Macro Export To SharePoint .xlsm

Boa noite pessoal.

 

Tenho uma planilha que possui varias colunas. Uma delas é a coluna "Fornecedor". 

Necessito de uma macro que divida todas as linhas de cada fornecedor em uma aba diferente com o nome do referido Fornecedor.

Vale ressaltar que os fornecedores não estão em ordem.

Ex:

Fornecedor

Wesled

Gestalco

Wesled 

 

 

Após esse passo, preciso que cada aba seja exportada para uma pasta no Sharepoint.

Cada Fornecedor em uma pasta com o próprio nome.

 

Conseguem me ajudar?

 

Desde já, obrigado!!

 

Wendell e pessoal.

 

Surgiu um outro problema. Se eu ao invés de enviar e-mail para os fornecedores, eu quiser salvar o arquivo (separado por fornecedor) em uma pasta no Sharepoint. Existe essa possibilidade?

Cada fornecedor teria sua pasta.

 

Por exemplo, 

 

tenho uma lista completa com varios fornecedores, quero separar essa lista e, por exemplo, criar um arquivo da FG e exportar para a pasta da FG no Sharepoint. O arquivo do fornecedor Abecom na pasta Abecom e por ai vai.

 

Obrigado!!

Valeu! Vou testar os dois!!

Obrigado David.sps. Vou dar uma olhada!

 

Alguem conhece outro?

Pessoal, bom dia.

 

Não sei se o tópico se encaixa nessa parte do fórum, se não for me indiquem onde é o local correto, por favor. 

 

Toda semana envio uma planilha com todos os pedidos de compras gerados no mês para os fornecedores. Então tenho 12 planilhas para os 12 fornecedores.

Hoje tenho uma macro que envia essa planilha excel por email.

 

Porém gostaria de saber se existe algum site que eu possa colocar essas planilhas e os fornecedores vão até o local e respondem. Porém o fornecedor só pode entrar na planilha que pertence a ele.

 

Existe algo do tipo? Tipo um Google Drive em que eu possa colocar senha nas pastas.

 

Desde já, muito obrigado!!!

Boa Patropi!!!!!!

 

É exatamente isso que eu precisava!!! 

MUITO OBRIGADO!

 

Salvou uns dias de trabalho aqui!!

 

Abraço!!!

É basicamente isso mesmo Patropi, mas preciso que seja uma formula mais dinâmica.

 

Como você mandou eu tenho que ir ajustando a formula para cada material, pois existem materiais com quantidades de linhas diferentes.

 

Precisava de algo que pudesse arrastar para a planilha inteira de uma vez. A planilha original possui mais de 300 mil linhas.

Quase isso Patropi, mas tem que repetir na coluna, não na linha.

 

Para ser repetido tem que ser o mesmo material e o mesmo centro (BA, AL, RJ......)

Patropi! Muito obrigado pela ajuda.

 

Mas na verdade eu preciso de algo bem mais simples acho que não expliquei direito, erro meu!

 

Preciso de algo tipo, criar na coluna "I", uma formula que mostre quais linhas estão repetidas para cada material. Usando o exemplo que mostrei:

 

Material      BA     AL    RS    RJ    SP              "I"

1234          Não   Sim   Não   Sim   Não          Repetido

1234          Não   Não  Sim    Não   Não

1234          Sim   Não   Não   Sim   Sim          Repetido

 

 

Pessoal, preciso de ajuda!!

 

No arquivo anexo, tenho uma lista com alguns Materiais e Abrangências de cada material (AL, BA, RS, RJ e SP).

Preciso de alguma fórmula ou código que possa identificar quais materiais possui mais de um contrato para alguma região.

 

Por ex:

 

Material      BA     AL    RS    RJ    SP

1234          Não   Sim   Não   Sim   Não

1234          Não   Não  Sim    Não   Não

1234          Sim   Não   Não   Sim   Sim

 

Nesse caso as linhas 1 e 3 possuem sim para a região de RJ. Preciso de algo que indique quais materiais possuem esse caso.

Vale ressaltar que a planilha original possue mais de 300.000 linhas.

 

Desde já agradeço com todas as forças!

Pasta1.xlsx

Marcus,

 

Para enviar os e-mails com assinatura eu faço o seguinte. Crio um e-mail em branco, deixo o texto padrão escrito no corpo dele e salvo na mesma pasta que está a planilha com a macro. Feito isso eu escrevo o código de forma que a macro use esse template para gerar e enviar os e-mails. O código ficaria assim:

Sub Send_Emails()Dim Folder As String, Recipient As String, Recipient2 As StringDim FSO As ObjectDim db As DAO.DatabaseDim rs As DAO.Recordset, rs2 As DAO.RecordsetDim c As LongDim OA As Object, OM As ObjectApplication.DisplayAlerts = FalseFolder = "C:\Users\marcur09\Desktop\A\"Set FSO = CreateObject("Scripting.FileSystemObject")Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")Set OA = CreateObject("Outlook.Application")For Each File In FSO.GetFolder(Folder).Files    Kill FileNextWhile Not rs.EOF    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")    Workbooks.Add        For c = 0 To rs2.Fields.Count - 1            Cells(1, c + 1) = rs2.Fields(c).Name        Next    Range("A2").CopyFromRecordset rs2    Range("A:A").TextToColumns    Range("A:A").NumberFormat = "dd/mm/yyyy"    Range("P:P").NumberFormat = "dd/mm/yyyy"    Range("A:AZ").EntireColumn.AutoFit    ActiveWorkbook.Close True, Folder & rs(0)    Set OM = OA.CreateItemFromTemplate(ThisWorkbook.Path & "\Template.msg")        With OM            Recipient = db.OpenRecordset("SELECT [E-Mail] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0)            Recipient2 = db.OpenRecordset("SELECT [Cc] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0)            .To = Recipient            .CC = Recipient2            .Subject = "Follow-Up - Lista de Pedidos Emitidos"            .Attachments.Add Folder & rs(0) & ".xlsx"            .Display        End With    rs.MoveNextWendEnd Sub

Segue também o template já com o seu texto padrão.

Boa Wendell! Funcionou direitinho!

 

Muito obrigado!!!!!

De linhas com certena não há limite. De e-mails eu não sei, não me lembro de precisar abrir muitos e-mails.

 

Geralmente eu faço esse tipo de macro até confirmar que está funcionando OK, depois altero a linha

.Display

Para

.Send

Dessa forma o e-mail é enviado sem eu precisar clicar em "Enviar". Já testei com 2.000 e-mails e foram todos enviados sem problemas,

Wendell!!

 

Preciso de uma ultima ajuda sua. Quando envio o email ele não esta vindo com minha assinatura! Procurei muito antes de vir aqui te pedir ajuda, mas não achei. Vale ressaltar que minha assinatura possui imagens.

 

Esse "Function GetSignature" funciona em uma outra macro minha.

 

Consegue me ajudar em mais essa?

Sub Send_Emails()Dim Folder As String, HTMLBody As String, Recipient As String, Recipient2 As StringDim FSO As ObjectDim db As DAO.DatabaseDim rs As DAO.Recordset, rs2 As DAO.RecordsetDim c As LongDim OA As Object, OM As ObjectApplication.DisplayAlerts = FalseFolder = "C:\Users\marcur09\Desktop\A\"     HTMLBody = "Prezado Fornecedor,<br>" & _     "<br>" & _"Estamos enviando uma lista que contém todos os PEDIDOS DE COMPRAS criados e enviados para sua empresa desde o dia 01/01/2015 até a data de hoje, todos os pedidos da lista encontram-se com o status de <b><u>'Não Atendido'</u></b> em nosso sistema, portanto estão atrasados." & _"<br>" & _"Esta planilha será enviada <b><u>mensalmente</u></b> e terá o objetivo de acompanhar a evolução dos atendimentos com a redução dos números de pedidos atrasos, portanto solicitamos que você avalie a lista e informe o motivo pelo qual o pedido ainda não foi faturado e entregue para a XXX, caso o pedido de compras já tenha sido atendido, favor informar na planilha o número da NF e data de emissão da mesma desta forma conseguiremos identificar onde o motivo de sua não digitação." & _"<br>" & _"Abaixo seguem os 'motivos' que deverão ser utilizados para a justificativa do não atendimento, é importante que eles sejam utilizados, pois iremos avaliar de forma padronizada os motivos do não atendimento;" & _"<br>" & _"<p><b>   1- Pedido Recebido - Será atendido" & _"<br>" & _"   2- Pedido Recebido c/ Divergências - Paralisado" & _"<br>" & _"   3- Pedido não recebido" & _"<br>" & _"   4- Pedido já faturado e entregue" & _"<br>" & _"   5- Pedido com solicitação de cancelamento" & _"<br>" & _"   6- Pedido não será atendido - Indicar a causa. </b></p>" & _"<br>" & _"<u>OBS:</u> Para os pedidos de compras onde o motivo do não atendimento for <b><u>'Pedido não recebido'</u></b> justificar na planilha e solicitar ao gestor de seu contrato a envio do mesmo em PDF para que o atendimento seja efetuado. " & _"<br>" & _"<p>A planilha deverá ser retornada para o e-mail  XXX em até 5 dias uteis após o seu recebimento, caso tenha qualquer dúvida em relação ao preenchimento entre em contato pelo fone Tel. +.</p>" & _"<br>" & _"<br>Sds."Set FSO = CreateObject("Scripting.FileSystemObject")Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")Set OA = CreateObject("Outlook.Application")For Each File In FSO.GetFolder(Folder).Files    Kill FileNextWhile Not rs.EOF    Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'")    Workbooks.Add        For c = 0 To rs2.Fields.Count - 1            Cells(1, c + 1) = rs2.Fields(c).Name        Next    Range("A2").CopyFromRecordset rs2    Range("A:A").TextToColumns    Range("A:A").NumberFormat = "dd/mm/yyyy"    Range("P:P").NumberFormat = "dd/mm/yyyy"    Range("A:AZ").EntireColumn.AutoFit    ActiveWorkbook.Close True, Folder & rs(0)    Set OM = OA.CreateItem(0)        With OM            Recipient = db.OpenRecordset("SELECT [E-Mail] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0)            Recipient2 = db.OpenRecordset("SELECT [Cc] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0)            .To = Recipient            .CC = Recipient2            .Subject = "Follow-Up - Lista de Pedidos Emitidos"            .HTMLBody = HTMLBody & "<br>"            .Attachments.Add Folder & rs(0) & ".xlsx"            .Display        End With    rs.MoveNextWendEnd SubFunction Getsignature(ByVal sFile As String) As String Dim FSO As Object Dim ts As Object Set FSO = CreateObject("Scripting.FileSystemObject") Set ts = FSO.GetFile(sFile).OpenAsTextStream(1, -2) Getsignature = ts.readall ts.Close End Function

Beleza!

 

Você me ajudou muito Wendell!! Não sei como te agradecer!

você é mestre!

 

Obrigado de verdade!

Boa Wendell!!!

 

Agora funcionou certinho!!!

 

Tem algum limite de email ou linhas?