Alyson Ronnan Martins

Boa noite @juliosonic. Seu código HTML parece estar correto em termos de SEO. Você tem as tags de título e meta corretas, incluindo og:title, og:site_name, twitter:title e outras tags importantes para SEO. No entanto, se o Google está mostrando o URL do seu site em vez do nome do site nos resultados da pesquisa, pode ser devido a alguns motivos possíveis12: Google ainda não indexou as alterações: Se você fez alterações recentemente no seu site, pode levar algum tempo para o Google rastrear e indexar essas alterações. Problemas de rastreamento ou indexação: Verifique se o Google pode rastrear e indexar seu site corretamente. Você pode usar a ferramenta Google Search Console para isso. Inconsistências nos sinais: Certifique-se de que o nome do seu site seja consistente em todo o seu site e em todas as suas tags de título e meta. Problemas com o arquivo sitemap.xml: Verifique se o seu arquivo sitemap.xml está atualizado e listando todas as páginas corretamente. Se você já verificou todos esses pontos e o problema persiste, pode ser útil entrar em contato com o suporte do Google ou consultar um especialista em SEO para obter ajuda adicional. Lembre-se de que a otimização para mecanismos de pesquisa pode levar algum tempo para produzir resultados, então tenha paciência. Espero que isso ajude! 😊

Boa noite @Diego Braga, não se ainda é possível restaurar se tiver com esse erro. Tenta instalar em uma máquina local e fazer o "restaure" dentro dessa máquina para validade algum erro no servido que esta restaurando.

Boa noite @ricardoweb084 eu recomendaria deixar sem borda e criar o próprio botão de fechar.

Opa boa noite. Pelo que eu entendi precisa escolher um modelo dependendo do usuário correto? Se sim você usar esse dado para abrir o modelo que deseja. Esse seria um exemplo: If rgFoco.Columns("AF").value = "Laudo novo" Then 'Define qual constante vai utilizar (novo) else 'Defini qual constante vai utilizar (antiga) end if Você também pode dublicar a procedure btGerarLaudo_Click e criar ele olhando para a nova constante que aponta para o laudo. Dessa maneira você teria dois botões sendo um para o laudo antigo e outro para o laudo novo.

Boa noite @Bruno Rafael do carmo izzo A palavra Brasil deveria estar em aspas simples: NASCIONALIDADE VARCHAR(20) DEFAULT 'BRASIL'

Boa tarde. @buscheric Deve ser rasuaveklment simples devido já ter um modelo criado. Você tem o documento novo com os "Bookmarks" , (referências para o VBA fazer a inclusão de dados do excel)? Caso já tenha feito a primeira coisa que vai fazer é definir a posição do novo modelo: Const modeloUS = "C:\Anima\Modelo Laudos\Laudo Abdominal.dotx" Pelo que entendi esse código acima é o modelo atual então vai criar o novo modelo exemplo: Const modeloUS = "C:\Anima\Modelo Laudos\Laudo Abdominal.dotx" Const modeloBR = "C:\Anima\Modelo Laudos\Laudo Abdominal2.dotx" Assim que for respondendo, vamos te ajudando a continuar.

Eu tentei no meu computador em casa mais o office atualizou e nem eu sei usar na versão mais recente. kkkk Segue o comando que tenho para fazer conexão com banco de dados do access: 'Criado por Alyson Ronnan Martins 'Data: 2021/11/12 'Utilizar a referência: Microsoft ActiveX Data Objects 6.1 Library Public db As ADODB.Connection Public rs As ADODB.Recordset Public Const DB_PATH As String = "C:\DB\" Public Const DB_NAME As String = "database.accdb" Public Sub cConnectOpen() On Error Resume Next Set db = New ADODB.Connection Dim Caminho As String Caminho = DB_PATH & DB_NAME If Dir(Caminho) = "" Then MsgBox "Não foi encontrador o banco de dados!" & Chr(13) & _ "Solicitar o suporte da verificar o caminho abaixo:" & Chr(13) & _ DB_PATH & DB_NAME, vbCritical, _ "Erro crítico!" Application.Quit End If With db .ConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _ "ReadOnly=0;" & _ "DBQ=" & Caminho & ";" & _ "DefaultDir=" & DB_PATH '& _ "Uid=Admin;Pwd=;" .Open End With 'Exemplo de fazer consulta 'Set rs = db.Execute("SELECT * FROM TABELA") 'rs.Close: Set rs = Nothing End Sub Public Sub cConnectClose() On Error Resume Next db.Close Set db = Nothing End Sub Agora para consultar os dados você cria um procedimento para executar uma consulta: sSQL = "SELECT * " & _ "FROM [nome tabela] " & _ Set rs = New ADODB.Recordset rs.Open sSQL, db, adOpenDynamic, adLockReadOnly retornoSQL = rs.EOF If retornoSQL = False Then Do Until rs.EOF Sheets("Planilha1").Cells(x + 1, 1).Value = rs.Fields("") Sheets("Planilha1").Cells(x + 1, 2).Value = rs.Fields("") Sheets("Planilha1").Cells(x + 1, 3).Value = rs.Fields("") Sheets("Planilha1").Cells(x + 1, 4).Value = rs.Fields("") Sheets("Planilha1").Cells(x + 1, 5).Value = rs.Fields("") rs.MoveNext x = x + 1 Loop end if @Domingos Oliveira Avalia se consegue entender e utilizar.

Boa tarde @Domingos Oliveira Precisa mesmo ser VBA? O import do EXCEL já traz as informações e é possível fazer SQL na hora de trazer as informações do ACCESS.

Boa tarde @ricardoweb084 Quando você pressiona botão F8 vai continuar até chegar na linha que esta gerando o erro de execução. Já fez esse procedimento?

@Albino Sergio Boa noite. Em que momento ou em que processo vai dispara o comando para criar a "aba" nova?

@leonidlo costa boa noite. Parece que o problema está na forma como você está usando a função AutoFilter e a tentativa de filtrar números como se fossem texto. Se a coluna 1 contém códigos de itens e você deseja filtrar por números, pode ser necessário ajustar a forma como você configura o critério de filtragem. Aqui está uma versão modificada do seu código que tenta lidar com números: Private Sub txtlist_Change() If txtlist.Value <> "" Then ' Verifica se o texto inserido é um número If IsNumeric(txtlist.Value) Then ' Se for um número, filtra a coluna 1 com critério numérico ActiveSheet.ListObjects("estoque").Range.AutoFilter Field:=1, Criteria1:=CLng(txtlist.Value) Else ' Se não for um número, filtra como texto ActiveSheet.ListObjects("estoque").Range.AutoFilter Field:=1, Criteria1:= _ "=*" & txtlist.Value & "*", Operator:=xlAnd End If Else ' Se o campo estiver vazio, remove todos os filtros ActiveSheet.ListObjects("estoque").Range.AutoFilter Field:=1 End If End Sub Essa versão do código primeiro verifica se o texto inserido na TextBox é um número usando a função IsNumeric. Se for um número, o filtro é aplicado usando o valor convertido para inteiro (CLng). Se não for um número, o filtro é aplicado como antes, tratando-o como texto. Espero que isso ajude a resolver o problema!

Se você deseja adaptar o código para selecionar apenas as colunas H até R em vez da linha inteira, você pode ajustar a maneira como o intervalo é tratado. Aqui está a versão adaptada do seu código: Sub DeleteRows() ' Update by 20211217 Dim rng As Range Dim InputRng As Range Dim DeleteRng As Range Dim DeleteStr As String Dim xTitleId As String Dim xArr Dim xF As Integer Dim xWSh As Worksheet On Error Resume Next xTitleId = "Excluir apostas" Set rng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, rng.Address, Type:=8) If InputRng Is Nothing Then Exit Sub DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) Set xWSh = InputRng.Worksheet For Each rng In InputRng ' Verifica se a célula contém o texto a ser excluído If rng.Value = DeleteStr Then ' Se DeleteRng ainda não foi definido, define-o como a célula atual If DeleteRng Is Nothing Then Set DeleteRng = rng.Offset(0, 7).Resize(, 10) ' Ajusta para selecionar da coluna H até R Else ' Caso contrário, une DeleteRng com a nova célula Set DeleteRng = Application.Union(DeleteRng, rng.Offset(0, 7).Resize(, 10)) End If End If Next ' Exclui as células selecionadas If Not DeleteRng Is Nothing Then DeleteRng.Delete End If End Sub As alterações foram feitas na linha: Set DeleteRng = rng.Offset(0, 7).Resize(, 10) Essa linha ajusta DeleteRng para começar da coluna H (Offset(0, 7)) e se estender até a coluna R (Resize(, 10)). Isso garante que somente as colunas desejadas sejam selecionadas para exclusão. Certifique-se de testar o código para garantir que ele atenda aos seus requisitos.

Boa tarde @andersonrich Como não tenho uma base de dados para testar meu código olha se esse código resolveu o que precisa: Function BuscaVertical(intervalo As Range, palavra As String) As Variant Dim c As Object Dim a() As Variant Dim posicao As Long posicao = 0 ' Redimensiona o array para garantir espaço suficiente ReDim a(1 To 1) For Each c In intervalo.Cells If palavra = c.Value Then ' Redimensiona o array para armazenar o novo valor encontrado posicao = posicao + 1 ReDim Preserve a(1 To posicao) a(posicao) = palavra End If Next c BuscaVertical = a End Function

Quando você abre o link não aparece esse botão? Só "logar" sua conta da microsoft Uma melhoria no código da alteração da planilha: Option Explicit 'Obrigado declarar o tipo de cada variável Public amountLines As Integer 'Linhas atuais na planilha Public isConfirmExclude As Boolean 'Variavel para confirmar se pode excluir a linhas Private Sub Worksheet_Change(ByVal Target As Range) 'A cada alteração na planilha é verificado se a quantidade de linha aumentou ou diminuiu Dim currentLines As Integer 'Declarado as linhas atuais Const COLUMN_BASE As String = "A" 'Coluna base para contar as linhas 'Pega o numero da ultima linha com base na na Coluna currentLines = ActiveSheet.Cells(Rows.Count, COLUMN_BASE).End(xlUp).Row If currentLines < amountLines Then 'Caso tenha diminuido a quantidade de linhas isConfirmExclude = False frmConfirmExclude.Show 'Caso não tenha sido autorizado e vai desfazer a alteração If Not isConfirmExclude Then Application.Undo currentLines = currentLines + 1 Else currentLines = currentLines + 1 End If End If amountLines = currentLines End Sub @Eduardonada

@Eduardonada Bom dia. Seu problema realmente precisou de uma lógica e pode ser que já até tenha resolvido ai kkkk Vamos lá: Na planilha1 do meu teste eu coloquei um variável para contar a quantidade de linhas existentes, também coloquei uma variável pare saber se está sendo autorizada a exclusão de linhas atuais (ou diminuição do total de linhas). Option Explicit 'Obrigado declarar o tipo de cada variável Public amountLines As Integer 'Linhas atuais na planilha Public isConfirmExclude As Boolean 'Variavel para confirmar se pode excluir a linhas Depois coloquei o evento a cada alteração acontecer na planilha ele chamar um formulário para saber se pode excluir ou não: Private Sub Worksheet_Change(ByVal Target As Range) 'A cada alteração na planilha é verificado se a quantidade de linha aumentou ou diminuiu Dim currentLines As Integer 'Declarado as linhas atuais Const COLUMN_BASE As String = "A" 'Coluna base para contar as linhas 'Pega o numero da ultima linha com base na na Coluna currentLines = ActiveSheet.Cells(Rows.Count, COLUMN_BASE).End(xlUp).Row If currentLines < amountLines Then 'Caso tenha diminuido a quantidade de linhas isConfirmExclude = False frmConfirmExclude.Show 'Caso não tenha sido autorizado e vai desfazer a alteração If Not isConfirmExclude Then Application.Undo End If End If amountLines = currentLines End Sub Agora chegou a parte do formulário. Foi criado um formulário passando apenas uma senha 123 para casa realmente a alteração esteja confirmada. Foi construído um código que vai alterar a variável isConfirmExclude caso o código pode ser excluído (lá da planilha1). Apenas quando a senha for digitada certa. Private Const PASSWORD As String = "123" 'Senha padrão para validação Private Sub btnConfirmar_Click() If txtPass.Value = PASSWORD Then Planilha1.isConfirmExclude = True 'Libera a alteração Unload frmConfirmExclude 'Fecha o formulário Else Planilha1.isConfirmExclude = False 'Priobindo a alteração End If End Sub Private Sub UserForm_Activate() Planilha1.isConfirmExclude = False 'Só por garantia que o valor vai ser falso quando abrir End Sub Claro que pode ficado difícil de imagina então estou colocando o código abaixo: Link(planilha onedrive): Eduardonada - UserForm por exclusão.xlsm

Bom dia @Maria Monica Loiola tenta usar esse código abaixo: Function crit(duration) As String Dim resultado As String Select Case duration Case Is < 21 resultado = "P1" Case Is <= 42 resultado = "P1 OU P2" Case Is <= 63 resultado = "P2 OU P3" Case Is <= 126 resultado = "P3 OU P4" Case Is <= 252 resultado = "P4 OU P5" Case Is <= 504 crit = "P5 OU P6" Case Is <= 756 resultado = "P6 OU P7" Case Is <= 1008 resultado = "P7 OU P8" Case Is <= 1260 resultado = "P8 OU P9" Case Is < 2520 resultado = "P9 OU P10" Case Else resultado = "P10" End Select crit = Replace End Function Como você fitou que a base de dados é muito grande, ficar fazendo "formulas" para retornar valores vai fazer seu código ficar lento ainda. O mais aconselhado é fazer um procedimento que percorrer sua base de dados e preencher der acordo com o que deseja. Funciona igual a uma formula porém vai fazer sozinho

Bom dia @Eduardonada O que esta pensando em "encontrar" é o índice para ser excluído ou a senha, ficou meio confuso seu texto.

Já tive problema assim e eu tive que dividir o processo do código, não deixa um único script fazer tudo o que era necessário. Mesmo assim olha se esse código tem o mesmo resultado: Sub AtribuirAtividades() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(5) ' Ajuste o índice se necessário Dim ultimaLinha As Long ultimaLinha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Dim funcionarios() As String funcionarios = Array("Diogo", "Yanna", "Débora", "Adenilson", "Analista 1", "Analista 2") Dim tiposAtividade As Collection Set tiposAtividade = New Collection Dim i As Long For i = 781 To ultimaLinha If Not IsEmpty(ws.Cells(i, 3).Value) Then Dim tipoAtividade As String tipoAtividade = CStr(ws.Cells(i, 3).Value) On Error Resume Next tiposAtividade.Add tipoAtividade, tipoAtividade On Error GoTo 0 End If Next i Dim mediaAtividadesPorTipo As Double mediaAtividadesPorTipo = Application.WorksheetFunction.RoundUp(tiposAtividade.Count / (UBound(funcionarios) + 1), 0) Dim contadorGeral As Long contadorGeral = 0 Dim tipo As Variant For Each tipo In tiposAtividade Dim contadorPorTipo As Long contadorPorTipo = 0 For Each funcionario In funcionarios For i = 781 To ultimaLinha If ws.Cells(i, 3).Value = tipo And ws.Cells(i, 12).Value = "" Then ws.Cells(i, 12).Value = funcionario contadorGeral = contadorGeral + 1 contadorPorTipo = contadorPorTipo + 1 If contadorPorTipo >= mediaAtividadesPorTipo Then Exit For End If End If Next i If contadorGeral >= ultimaLinha Then Exit For Next funcionario If contadorGeral >= ultimaLinha Then Exit For Next tipo End Sub @Diogo Muscardi

Bom dia @VBA CODE FROM EXCEL TO POW Olha se o código abaixo consegue funcionar no seu processo. Sub PasteExcelDataIntoPowerPointTextbox() Dim ppApp As Object Dim ppSlide As Object Dim ppTextBox As Object Dim xlApp As Excel.Application Dim xlWorkbook As Excel.Workbook Dim xlWorksheet As Excel.Worksheet Dim excelRange As Excel.Range Dim filePath As String ' Initialize PowerPoint and Excel Set ppApp = CreateObject("PowerPoint.Application") ppApp.Visible = True ' Make PowerPoint visible ' Get the PowerPoint file path filePath = Application.GetOpenFilename("PowerPoint Files (*.pptx), *.pptx") If filePath = "False" Then Exit Sub ' User cancelled ' Open the PowerPoint presentation Set ppPresentation = ppApp.Presentations.Open(filePath) ' Assuming the Excel file is already open, else you can open it too Set xlApp = GetObject(, "Excel.Application") Set xlWorkbook = xlApp.ActiveWorkbook Set xlWorksheet = xlWorkbook.Worksheets("HiringResults") ' Change to your sheet name ' Define the ranges and corresponding shape names Dim ranges As Variant Dim shapes As Variant ranges = Array("C1", "C2", "D3", "D4", "D5", "D6", "D7", "D8", "D9", "D10", "D11", "D12", "D13", "D14", "D15", "D16", "D17", "D18", "D19", "D20", "D21") shapes = Array("REFTYPE", "REFBUSINESS", "REFNUMBERFILLS", "REFVARIATION", "REFTTF", "REFCNPS", "REFHMNPS", "REFACTREQ", "REFDIVMALE", "REFDIVFAME", "REFHIREINT", "REFHIREEXT", "REFTSTASO", "REFTSEMRE", "REFTSAGENC", "REFLEVEX", "REFLEVDI", "REFLEVMA", "REFLEVIN", "REFDATAREF", "REFKEYINSIGHTS") ' Loop through the ranges and shapes For i = 0 To UBound(ranges) Set excelRange = xlWorksheet.Range(ranges(i)) Set ppSlide = ppPresentation.Slides(1) Set ppTextBox = ppSlide.Shapes(shapes(i)).TextFrame.TextRange excelRange.Copy ppTextBox.Paste Next i ' Clean up Set ppApp = Nothing Set xlApp = Nothing Set xlWorkbook = Nothing Set xlWorksheet = Nothing Set ppPresentation = Nothing MsgBox "Report completed. Please edit and save it." End Sub

Boa tarde. @MColucci. Private Sub txtValorCP_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim zTemp As String txtValorCP.TextAlign = fmTextAlignRight If IsNumeric(Chr(KeyCode)) Or KeyCode = 8 Or (KeyCode >= 96 And KeyCode <= 105) Then If txtValorCP.Text <> "" Then zTemp = txtValorCP.Text & IIf(KeyCode <> 8, Chr(IIf(KeyCode >= 96 And KeyCode <= 105, KeyCode - 48, KeyCode)), "") zTemp = Right(zTemp, Len(zTemp) - 2) zTemp = Replace(zTemp, ".", "") zTemp = Replace(zTemp, ",", "") If KeyCode = 8 Then If Len(zTemp) > 3 Then zTemp = Left(zTemp, Len(zTemp) - 1) Else zTemp = "0" & Left(zTemp, Len(zTemp) - 1) End If End If zTemp = Left(zTemp, Len(zTemp) - 2) & "." & Right(zTemp, 2) Else zTemp = "0.0" & IIf(KeyCode <> 8, Chr(IIf(KeyCode >= 96 And KeyCode <= 105, KeyCode - 48, KeyCode)), "0") End If txtValorCP.Text = Format(Val(zTemp), "R$ ###,##0.00") KeyCode = 0 Else If KeyCode <> 13 And KeyCode <> 9 And KeyCode <> 40 And KeyCode <> 38 Then KeyCode = 0 End If End Sub Seu código foi adaptado coloca uma interpretação dos 'keycode' 96 ao 105 que são os números do teclado numério. olha se funciona no seu código.

@Diego.Machado

É uma pergunta?

Boa tarde. verificar o código abaixo:

Boa tarde. Verifica a resposta no link abaixo:

Boa tarde @Diego.Machado. Fiz uma revisão no código e parou o erro aqui para mim. Faz o teste ai nele: Consultar Status do CNPJ.xlsm Sub ConsultarCNPJ() ' Adicionar a referência Microsoft HTML Object Library Dim IE As Object Dim doc As HTMLDocument Dim CNPJ As Range Dim Status As String Dim countLoop As Long ' Criar um novo objeto Internet Explorer Set IE = CreateObject("InternetExplorer.Application") ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida) For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row) countLoop = countLoop + 1 Debug.Print countLoop ' Navegar para o site de consulta de CNPJ IE.navigate "https://www.situacao-cadastral.com/" ' Aguardar até que a página seja carregada Do While IE.Busy Or IE.readyState <> 4 DoEvents Loop ' Inserir o CNPJ no campo de pesquisa e clicar no botão de pesquisa Set doc = IE.document doc.getElementById("doc").Value = CNPJ.Value doc.getElementById("consultar").Click ' Aguardar até que a página com os resultados seja carregada Do While IE.Busy Or IE.readyState <> 4 DoEvents Loop ' Extrair o status do CNPJ e escrever na coluna B Set doc = IE.document Status = doc.getElementsByClassName("vrd")(0).innerText CNPJ.Offset(0, 1).Value = Status Debug.Print "O CNPJ " & CNPJ.Value & " foi consultado." Next CNPJ ' Fechar o Internet Explorer IE.Quit End Sub