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

Boa Wendell! Funcionou direitinho! Muito obrigado!!!!!

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?