Douglas ianes

@Midori no caso o setfocus seria logo abaixo do log = empty

Private Sub Log_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If Len(Log) = 9 Then

Sheets("BD").Select
Range("B3").Select
    Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
     
    ActiveCell = Log.Value

Log = Empty

Log.SetFocus
Sheets("plano").Select

Else

MsgBox "SN Incorreto!!!"

Log = Empty

End If

End Sub

Em 17/07/2021 às 10:17, Douglas ianes disse:

Bom dia caros amigos.

 

estou com dificuldade em colocar o setfocus na caixa textbox que preciso ao final do código.

 

Private Sub Log_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If Len(Log) = 9 Then

Sheets("BD").Select
Range("B3").Select
    Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
     
    ActiveCell = Log.Value

Log = Empty
Sheets("plano").Select

Else

MsgBox "SN Incorreto!!!"

Log = Empty

End If

End Sub

 

podem me ajudar por favor.

@Midoriconsegue me ajudar, por favor.

Bom dia caros amigos.

estou com dificuldade em colocar o setfocus na caixa textbox que preciso ao final do código.

Private Sub Log_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If Len(Log) = 9 Then

Sheets("BD").Select
Range("B3").Select
    Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
     
    ActiveCell = Log.Value

Log = Empty
Sheets("plano").Select

Else

MsgBox "SN Incorreto!!!"

Log = Empty

End If

End Sub

podem me ajudar por favor.

@Midori estou tendo a seguinte mensagem.

Em 23/03/2021 às 08:00, Douglas ianes disse:

\\105.103.176.169\EasyCoder PF4i (203 dpi) - DP em Ne04:

conseguir entender a execução da rotina e funcionou, muito obrigado pela ajuda.

@Midoriainda a respeito deste caso, consegui fazer funcionar direcionando pra impressora correta.

Agora estou enfrentando outro problema, a impressora e compartilhada em rede através de um PC local, todos os dias pelas manha tenho dificuldade em usar a planilha devido o computador ter senha de acesso, ai eu tenhoq ue ir em todos os PCs que usam essa planilha e "mapear" o PC compartilhado com a impressora.

è possivel eu incluir o usuario e senha no código?

21 horas atrás, Midori disse:

@Douglas ianes  Quando você coloca manualmente essa impressora da rede como padrão qual é a saída deste comando na célula A1?

 

[A1] = Application.ActivePrinter

 

\\105.103.176.169\EasyCoder PF4i (203 dpi) - DP em Ne04:

20 minutos atrás, Douglas ianes disse:

\\105.103.176.169\EasyCoder PF4i (203 dpi) - DP em Ne04:

conseguir entender a execução da rotina e funcionou, muito obrigado pela ajuda.

@Midori quando eu coloco ela como padrão manualmente ai sim o codigo pega a string, mas quando volto para a outra impressora comun que deve ser a padrão ai imprimi da errada.

acho que eu não estou entendendo a forma de usar activeprinter.

4 horas atrás, Midori disse:

@Douglas ianes  Tente passar o endereço para o parâmetro ActivePrinter,

 

ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
    ActivePrinter:="\\105.103.176.169\EasyCorder_PF4i_(203_dpi)-DP", _
    Collate:=True, IgnorePrintAreas:=False

 

Não deu certo, imprimiu direto na impressora que uso como padrão.

15 horas atrás, Douglas ianes disse:

Boa tarde pessoal.

 

estou usando este codigo para imprimir uma userform em uma impressora especifica.

 

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        'IgnorePrintAreas:=False

 

Problema é que uso outras planilhas automatizadas que precisam imprimir em outra impressora, então esse codigo precisaria indicar o endereço da impressora a ser impresso, que no caso seria esse:

 

\\105.103.176.169\EasyCorder_PF4i_(203_dpi)-DP

 

consegue me ajudar a fazer com que esse codigo imprima direto neste endereço?

@Midori  consegue me ajudar

Boa tarde pessoal.

estou usando este codigo para imprimir uma userform em uma impressora especifica.

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        'IgnorePrintAreas:=False

Problema é que uso outras planilhas automatizadas que precisam imprimir em outra impressora, então esse codigo precisaria indicar o endereço da impressora a ser impresso, que no caso seria esse:

\\105.103.176.169\EasyCorder_PF4i_(203_dpi)-DP

consegue me ajudar a fazer com que esse codigo imprima direto neste endereço?

BOm dia Pessoal.

estou utilizando o codigo abaixo para me ajudar a criar pastas para um banco de dados de possue.

porém ele utiliza um campo de data para dar nome a pasta, como neste campo tem / o codigo da erro.

 eu preciso substituir o / por -

<Sub criar_patas()

    Dim Rng As Range
    Dim maxRows As Long, maxCols As Long, r As Long, c As Long
    
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    
    Set Rng = Selection
    maxRows = Rng.Rows.Count
    maxCols = Rng.Columns.Count
    
        r = 1
        Do While r <= maxRows
            If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, 1), vbDirectory)) = 0 Then
                MkDir (ActiveWorkbook.Path & "\" & Rng(r, 1) & " - " & Rng(r, 2) & " - " & Rng(r, 9) & " - " & Rng(r, 14))
                On Error Resume Next
            End If
            r = r + 1
        Loop

    
    
End Sub>

no campo grifado e em negrito é onde ele busca a celula onde contem data.

alguem pode me ajudar.

@Midori Funcionou perfeitamente.

agora vou aperfeiçoar outras funções.

muito obrigado pela ajuda.

@Midori a principio o codigo que me passou deu certo. 

ficou assim.

Sub Enviar_email()

Set objeto_outlook = CreateObject("outlook.application")
Set Email = objeto_outlook.CreateItem(0)

Email.Display

Email.To = "[email protected]"
Email.cc = Cells(2, 1).Value & "@gmail.com"

Email.Subject = "Segue notificação de falha"

Email.attachments.Add ActiveWorkbook.FullName
Email.attachments.Add "C:\Temp\painel.JPG"

Email.HTMLBody = "Olá," _
    & Chr(10) & Chr(10) & "Segue em anexo notificação de falha encontrada em OQC." _
    & Chr(10) & Chr(10) & "Qualquer dúvida, favor entrar em contato com " & Cells(2, 1).Value & _
    "<html><img src=""cid:painel.JPG""</img></html>

Email.send

End Sub

somente as quebra de texto que não estão funcionando.

ja tentei <br> também e não consegui.

Boa tarde pessoal.

estou montando esse código para enviar uns relatórios por email, porém preciso anexar um grafico no corpo do email como imagem.

Fato é que se eu salvar o arquivo em algum local como imagem pra depois usar no codigo um SW da empresa bloqueia essa imagem, então eu preciso que gere a imagem direto no corpo do email.

<Sub Enviar_email()

Call Mostra

Set objeto_outlook = CreateObject("outlook.application")
Set Email = objeto_outlook.CreateItem(0)

Email.Display

Email.To = "[email protected]"
Email.cc = Cells(2, 1).Value & "@samsung.com"

Email.Subject = "Segue notificação de falha"

Email.Body = "Olá," _
    & Chr(10) & Chr(10) & "Segue em anexo notificação de falha encontrada em OQC." _
    & Chr(10) & Chr(10) & "Qualquer dúvida, favor entrar em contato com " & Cells(2, 1).Value

  
Email.attachments.Add ActiveWorkbook.FullName

Email.send

End Sub>

como se fosse concatenado com o corpo do email

alguem pode me ajduar??

Bom dia Pessoal.

estou colocando um código em uma planilha para enviar email ao final de outra sequencia de código.

porém eu quero que anexe o mesmo arquivo que esta rodando a macro, e não estou conseguindo.

segue o código

<Sub Enviar_email()

Set objeto_outlook = CreateObject("outlook.application")
Set Email = objeto_outlook.createitem(0)

Email.display

Email.to = Cells(2, 1).Value
Email.cc = "[email protected]"

Email.Subject = "Segue notificação de falha"

Email.body = Cells(2, 1).Value & "\venda -" & Chr(10) & Cells(2, 3).Value _
  & "Atenciosamente"
  
Email.attachments.Add ThisWorkbook.Name

Email.send

End Sub>

a principio havia conseguido enviar, porém quando mudei o arquivo de pasta esta dando erro na hora de anexar.

este arquivio será dinamico com nome e local diferente todos os dias.

3 horas atrás, Midori disse:

É só passar o caminho do arquivo para a propriedade TargetPath.

 

As variáveis Temp e FileExt... não são do arquivo xlsx? Tente fazer assim,

 

S.TargetPath = TempFilePath & TempFileName & FileExtStr

 

 

Deu certo sim, muito obrigado pela ajuda.

@Midori Muito obrigado, estou com meio caminho andando,

agora o problema que surgiu é que na hora que cria o atalho estou com 2 arquivos abertos, o arquivo XLSM e um arquivos XLSX que o codigo converte pra mim e apaga o XLSM ao final.

esta criando atalho do arquivo xlsm, preciso que crie do arquivo xlsx que esta sendo criado.

segue o codigo completo

<Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    Set Sourcewb = ActiveWorkbook

    'Copia a planilha inteira
    Sheets.Copy
    
    Set Destwb = ActiveWorkbook
    
                        FileExtStr = ".xlsx": FileFormatNum = 51
    
    'Salve a nova pasta de trabalho e feche-a
    TempFilePath = ThisWorkbook.Path & "\"
    TempFileName = VBA.Left(ThisWorkbook.Name, (VBA.InStrRev(ThisWorkbook.Name, ".", -1, VBA.vbTextCompare) - 1))

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        
Dim Atalho, Pasta   As String
Dim W, S            As Object
    
Pasta = "\\105.103.12.249\oqc\04.OQC-INSPECTION\01.ANALISES\01.Analise de Falhas OQC\02.Banco de dados\2020\" & Nome & "\"
Atalho = Pasta & ThisWorkbook.Name & ".lnk"
    
Set W = CreateObject("Wscript.Shell")
Set S = W.CreateShortcut(Atalho)
    
S.TargetPath = ActiveWorkbook.FullName
S.IconLocation = Application.Path & "\Excel.exe"
S.Save

        .Close SaveChanges:=False
        
    End With
  

Dim xFullName As String
xFullName = Application.ActiveWorkbook.FullName
ActiveWorkbook.Saved = True
Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill xFullName
Application.ActiveWorkbook.Close False

  Excel.Application.Quit>

@Midori na realidade deu certo sim, eu me confundi porque ele esta pegando a extensão e utilizando como nome.

no caso eu quero que o atalho tenha o mesmo nome sem a extensão .xlsm como parte do nome.

Bom dia pessoal.

tem uma planilha que preciso salvar um atalho dela em outra pasta para consulta de outro setor, consegui esse código para criar o atalho:

<Dim Atalho As String, Pasta As String
Dim LocalExcel As String, Livro As String

Pasta = "C:\Users\douglas.i\Desktop\Nova pasta (2)\"
Atalho = Pasta & ActiveWorkbook.Name & ".lnk"

LocalExcel = Application.Path & "\Excel.exe"
Livro = ActiveWorkbook.FullName

Open Atalho For Output As #1
    Print #1, "[InternetShortcut]" & vbCrLf & "lnk = " & Livro
    Print #1, "IconIndex=1" & vbCrLf & "IconFile=" & LocalExcel
Close #1>

o atalho esta sendo criado mas o arquivo da erro na hora de abrir, ja tentei url e lnk 

lnk eu clico e não acontece nada com o atalho, url da mensagem de destino de internet não é valido

podem me ajudar.

@Basole Consegui, muito obrigado.

tive que adaptar para o resultado aparecer na mesma planilha ao invés de aparecer na plan2.

ai utilizar somente o = para trazer a informação para a aba que eu precisava.

Obrigado pela ajuda.

@Basole aqui no meu PC esta abrindo normal, não sei o que pode estar acontecendo.

mas coloquei assim os códigos que me enviou.

Plan1

Private Sub Worksheet_Change(ByVal Target As Range) If Not Excel.Application.Intersect(Target, Range("A2:A10")) Is Nothing Then Sheets("Plan2").Range("A2").Value2 = GoogleTranslate(Target.Value2, "en") End If End Sub

Esta pasta de trabalho

Function GoogleTranslate(InputText As String, ToLang As String) As String

Dim IE As Object

Set IE = CreateObject("InternetExplorer.application")

IE.Visible = False

IE.navigate "http://translate.google.com/#auto/" & ToLang & "/" & InputText Do Until IE.ReadyState = 4 DoEvents Loop Application.Wait (Now + TimeValue("0:00:5"))

Do Until IE.ReadyState = 4

DoEvents

Loop

GoogleTranslate = IE.Document.getElementsByClassName("result-shield-container tlid-copy-target")(0).innertext IE.Quit End Function

depois tentei colocar em um modulo ao invés de Esta pasta de trabalho.

e nos dois casos deu erro.

estou tentando mandar as imagens mas esta dando erro de upload

@Basole acho que eu devo esta colocando no local errado o codigo.

segue arquivo que estou usando.

teste tradução.7z

@Basole esta dando erro de compilação: sub ou function não definida.

Sheets("Plan2").Range("A2").Value2 = GoogleTranslate(Target.Value2, "en")

@Basole consegue me ajudar com a questão acima??

@gustavoomt como utilizar esta função??

eu vi algo dizendo que só funcionaria usando uma versão diferente do Excel tradicional.

Bom dia pessoal.

preciso fazer com que o texto escrito em português em uma célula da plan1 seja traduzido para inglês de forma automática em outra célula da plan2.

podem me ajudar com isso.