Kelvim

Boa tarde Eu estou tentando automatizar uma planilha e colocar um código para a planilha fazer uma conexão com um TXT porém, quando faço manualmente o processo roda. Quando faço utilizando a macro ocorre um erro [Expression.Error] O valor não é uma cadeia de único caractere. ActiveWorkbook.Queries.Add Name:="04", Formula:= _ "let" & Chr(13) & "" & Chr(10) & " Fonte = Csv.Document(File.Contents(""S:\04.txt""),[Delimiter="" "", Columns=20, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Tipo Alterado"" = Table.TransformColumnTypes(Fonte,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", ty" & _ "pe text}, {""Column5"", type text}, {""Column6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18" & _ """, type text}, {""Column19"", type text}, {""Column20"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Tipo Alterado""" ActiveWorkbook.Worksheets.Add With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _ "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=04;Extended Properties=""""" _ , Destination:=Range("$A$1")).QueryTable .CommandType = xlCmdSql .CommandText = Array("SELECT * FROM [04]") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .ListObject.DisplayName = "_04" .Refresh BackgroundQuery:=False End With

Boa tarde Tem um código que traz as informações da pagina da Web para o Excel. Gostaria de saber se eu consigo escolher um Item em especifico para ele trazer. .document.getelementbyid("teste").Value Eu tenho o ID da tabela porém não consigo utilizar o código abaixo para trazer. Ele traz apenas os texto a tabela ele não traz. With Sheets("RASCUNHO").QueryTables.Add(Connection:="URL;" & myURL, Destination:=Sheets("RASCUNHO").Range("a1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True End With

Consegui utilizando o código abaixo, Sub CSV() Dim MyFileName As String Dim CurrentWB As Workbook, TempWB As Workbook Application.DisplayAlerts = False Application.Calculation = xlCalculationManual ENDERECO = ActiveWorkbook.Path Windows("PASTA X").Activate Sheets("TESTE").Select Range("AG1:AK1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Workbooks.Add arquivo02 = ActiveWorkbook.Name ActiveSheet.Paste plan = ActiveSheet.Name Rows("1:1").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Application.DisplayAlerts = False Set CurrentWB = ActiveWorkbook ActiveWorkbook.ActiveSheet.UsedRange.Copy Set TempWB = Application.Workbooks.Add(1) With TempWB.Sheets(1).Range("A1") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats End With 'Dim Change below to "- 4" to become compatible with .xls files 'MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv" MyFileName = "C:\TESTE.csv" 'Range("f5").Value = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv" Application.DisplayAlerts = False TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True TempWB.Close SaveChanges:=False Application.DisplayAlerts = True Windows(arquivo02).Close False Windows("PASTA X").Activate Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True End Sub

Boa tarde Gostaria de saber como posso escolher um arquivo quando vou fazer Upload de um arquivo pelo VBA Excel no Internet Explorer. Ele abre o Windows Explorer, porém não consigo manipular.

Boa tarde Gostaria de saber como exportar uma planilha do Excel para CSV porém quando faço isso ele exporta tudo concatenado na mesma célula da coluna A separado por "," virgula. Gostaria de saber como exportar pelo VBA para CSV e de forma que cada valor seja separado por ";" ponto e virgula. Att

Boa tarde Consegui resolver utilizando um Loop e informando que na célula X sera plotado a célula da tabela com a propriedade innerHTML Cells(linh, 10).Value = td.innerHTML

Boa tarde Gostaria de saber como posso fazer uma varredura em um SITE XXXX procurando todos IE.document.getElementsByClassName("listar botao") e retornar no EXCEL a Propriedade do Campo Href. Att

Bom dia Gostaria de pedir uma ajuda. Alguém saberia exportar apenas o gráfico como PDF e ajustar o tamanho a folha. Att

A estrutura da pagina da Internet esta da seguinte maneira abaixo. onde tem as ultimas três TAG que se eu conseguisse chegar em qualquer um delas eu conseguiria ativar a opção de botão problema que ela esta muito escondida. Como posso clicar na ultima TAG por exemplo? <HTML> <HEAD> <IFRAME>{IFRAME 0} <BODY> <TABLE> <TR> <DIV> <FORM> <TABLE> <TR> <TR> <TD> <TABLE> <TR> <TD> <TABLE> <TR> <TD> <DIV> <DIV> <DIV> <DIV> <DIV> <DIV> <SPAN CLASS ="urNoUserSelect lsButton--content lsControl--centeraligned "> <IMG CLASS= "urImgBtn lsButton__image"> <SPAN CLASS = "lsButton--onlyImage-pusher">

@CasaDoHardware Não conheci este procedimento. Já serviu, obrigado mesmo. Atenciosamente

Boa noite Estou tentando implementar um loop no Excel com um um Exit Do para sair do processo quando for pressionado uma tecla. Entretanto não estou conseguindo. Alguem saberia como posso fazer um Loop e quando pressionar o F3 no Excel ele finalizar o Loop Do While. Atenciosamente

Boa tarde Eu estou tentando fazer um código para manipular uma pagina da Internet, entretanto esta página quando eu tento manipular os campos eu não estou conseguindo porque os campos em questão dentro de Frame. É uma página, dentro dela dois frames, e dentro do Frame01 um os campos que desejo manipular. Gostaria de saber como posso através do VBA EXCEL IE por exemplo clicar no botão XXX que está dentro de um frame. .document.getElementById("btnPersonas_5ECB2AD5B40A1ED698E1533408DF8619").click Att

Boa noite Eu estou editando um código e não estou conseguindo colocar para que uma imagem quem esta dentro de uma DIV seja alterada a cada X tempo. Gostaria de por exemplo a cada 30 segundos uma imagem, depois de 30 segundos outra imagem. Queria alterar entre a imagem de Index 0 e Index 1. ******************************************************************************************************** ********** Index 0 ************** <div data-image-index="0" data-displayer-width="1678" data-displayer-height="1119" data-displayer-uri="45b0e3_f2808e64042b45f7ade77b6229a3d126~mv2.jpg" data-height-diff="0" data-width-diff="0" data-bottom-gap="0" data-image-wrapper-right="0" data-image-wrapper-left="0" data-image-wrapper-top="0" data-image-wrapper-bottom="0" data-margin-to-container="0" itemscope="" itemtype="http://schema.org/ImageObject" style="position: absolute; left: 0px; top: 0px; opacity: 0.000164131; visibility: inherit; height: 553px; width: 100%;" class="style-isqm9g1yimageItem" data-state="notShowPanel desktopView unselected clipImage transIn normal noLink" id="comp-isqm6ofodataItem-iv884ilb"> ********** Index 1 ************** <div data-image-index="1" data-displayer-width="1700" data-displayer-height="1130" data-displayer-uri="45b0e3_4a186640b54f4ce38907204ea23571c1~mv2.jpg" data-height-diff="0" data-width-diff="0" data-bottom-gap="0" data-image-wrapper-right="0" data-image-wrapper-left="0" data-image-wrapper-top="0" data-image-wrapper-bottom="0" data-margin-to-container="0" itemscope="" itemtype="http://schema.org/ImageObject" style="position: absolute; left: 0px; top: 0px; opacity: 0.382182; height: 553px; width: 100%; visibility: inherit;" class="style-isqm9g1yimageItem" data-state="notShowPanel desktopView unselected clipImage transOut rollover noLink" id="comp-isqm6ofodataItem-iv883xp0"> ******************************************************************************************************** <div id="c1537inlineContent" class="p1inlineContent"> <div style="overflow: hidden; left: 0px; right: 0px; position: absolute; margin-left: 0.5px; margin-right: 0px; top: 81px; height: 550px; width: 100%;" data-gallery-id="comp-isqm6ofo" data-height-diff="0" data-width-diff="0" class="style-isqm9g1y" data-state="hidePlayButton autoplayOn notMobile desktopView touchRollOut animationInProcess" id="comp-isqm6ofo"> <div class="style-isqm9g1y_border"></div> <div style="height: 100%; z-index: 0;" data-gallery-id="comp-isqm6ofo" id="comp-isqm6ofoitemsContainer" class="style-isqm9g1yitemsContainer"> <div data-image-index="0" data-displayer-width="1678" data-displayer-height="1119" data-displayer-uri="45b0e3_f2808e64042b45f7ade77b6229a3d126~mv2.jpg" data-height-diff="0" data-width-diff="0" data-bottom-gap="0" data-image-wrapper-right="0" data-image-wrapper-left="0" data-image-wrapper-top="0" data-image-wrapper-bottom="0" data-margin-to-container="0" itemscope="" itemtype="http://schema.org/ImageObject" style="position: absolute; left: 0px; top: 0px; opacity: 0.000164131; visibility: inherit; height: 553px; width: 100%;" class="style-isqm9g1yimageItem" data-state="notShowPanel desktopView unselected clipImage transIn normal noLink" id="comp-isqm6ofodataItem-iv884ilb"> <div draggable="false" style="cursor:default;height:100%;width:100%;position:absolute;top:0px;left:0px;user-select:none;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-drag:none;-webkit-user-drag:none;-moz-user-drag:none;-ms-user-drag:none;user-modify:read-only;-webkit-user-modify:read-only;-moz-user-modify:read-only;-ms-user-modify:read-only" data-page-item-context="dataItem-isqm6ogz" data-gallery-id="comp-isqm6ofo" id="comp-isqm6ofodataItem-iv884ilblink" class="style-isqm9g1yimageItemlink"> <div style="height: 553px; width: 100%; margin: 0px;" id="comp-isqm6ofodataItem-iv884ilbimageWrapper" class="style-isqm9g1yimageItemimageWrapper"> <div style="cursor:default" id="comp-isqm6ofodataItem-iv884ilbzoom" class="style-isqm9g1yimageItemzoom"> <div style="position: relative; width: 100%; height: 553px; overflow: hidden;" data-style="position:relative;overflow:hidden" class="style-isqm9g1yimageItemimage" id="comp-isqm6ofodataItem-iv884ilbimage"> <img id="comp-isqm6ofodataItem-iv884ilbimageimage" alt="" data-type="image" itemprop="contentUrl" src="TESTE _ Início_files/45b0e3_f2808e64042b45f7ade77b6229a3d126_mv2.webp" style="width: 100%; height: 553px; object-fit:cover;"> </div></div></div> <div id="comp-isqm6ofodataItem-iv884ilbpanel" class="style-isqm9g1yimageItem_pnl style-isqm9g1yimageItempanel"> <h3 aria-hidden="true" style="text-align:left" itemprop="name" id="comp-isqm6ofodataItem-iv884ilbtitle" class="style-isqm9g1yimageItemtitle"></h3> <p id="comp-isqm6ofodataItem-iv884ilbDescription" style="text-align:left" itemprop="description" class="style-isqm9g1yimageItemdescription">TESTEogados Belo Horizonte</p></div></div></div> <div data-image-index="1" data-displayer-width="1700" data-displayer-height="1130" data-displayer-uri="45b0e3_4a186640b54f4ce38907204ea23571c1~mv2.jpg" data-height-diff="0" data-width-diff="0" data-bottom-gap="0" data-image-wrapper-right="0" data-image-wrapper-left="0" data-image-wrapper-top="0" data-image-wrapper-bottom="0" data-margin-to-container="0" itemscope="" itemtype="http://schema.org/ImageObject" style="position: absolute; left: 0px; top: 0px; opacity: 0.382182; height: 553px; width: 100%; visibility: inherit;" class="style-isqm9g1yimageItem" data-state="notShowPanel desktopView unselected clipImage transOut rollover noLink" id="comp-isqm6ofodataItem-iv883xp0"> <div draggable="false" style="cursor:default;height:100%;width:100%;position:absolute;top:0px;left:0px;user-select:none;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-drag:none;-webkit-user-drag:none;-moz-user-drag:none;-ms-user-drag:none;user-modify:read-only;-webkit-user-modify:read-only;-moz-user-modify:read-only;-ms-user-modify:read-only" data-page-item-context="dataItem-isqm6ogz" data-gallery-id="comp-isqm6ofo" id="comp-isqm6ofodataItem-iv883xp0link" class="style-isqm9g1yimageItemlink"> <div style="height: 553px; width: 100%; margin: 0px;" id="comp-isqm6ofodataItem-iv883xp0imageWrapper" class="style-isqm9g1yimageItemimageWrapper"> <div style="cursor:default" id="comp-isqm6ofodataItem-iv883xp0zoom" class="style-isqm9g1yimageItemzoom"> <div style="position: relative; width: 100%; height: 553px; overflow: hidden;" data-style="position:relative;overflow:hidden" class="style-isqm9g1yimageItemimage" id="comp-isqm6ofodataItem-iv883xp0image"> <img id="comp-isqm6ofodataItem-iv883xp0imageimage" alt="" data-type="image" itemprop="contentUrl" src="TESTE_Início_files/45b0e3_4a186640b54f4ce38907204ea23571c1_mv2.webp" style="width: 100%; height: 553px; object-fit: cover;"></div></div></div>

Bom dia Esqueci de marca como resolvido. Mas muito obrigado

Boa noite Tenho um arquivo do Access. Onde tenho uma tabela onde tem um campo onde a configuração é para texto longo. No formulário campo texto entretanto só é exibido 255 caracteres. Se alguém souber como resolver.

@Basole Segue acima

esta por exemplo na aba MENSAG - PRESENCIAL celula A44 porém na mesma aba MENSAG - PRESENCIAL existe alguns gráficos que também gostaria de enviar

Boa tarde Eu estou utilizando um código que envia email pelo Excel usando o Outlook. porém este código em questão eu não consigo enviar a imagem que estiver no corpo da planilha. Gostaria de saber se alguem conseguiria me ajudar. Sub ENVIAR_HTML() Dim OutApp As Object Dim OutMail As Object Dim rng As Range Dim resultado As VbMsgBoxResult Set rng = Nothing Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) Application.DisplayAlerts = False resultado = MsgBox("Tem certeza que deseja Enviar o Arquivo?", vbYesNo, "ENVIAR ARQUIVO") If resultado = vbYes Then ArqAberto01 = ActiveWorkbook.Name Application.DisplayAlerts = False Windows(ArqAberto01).Activate Application.Dialogs(xlDialogOpen).Show ArqAberto02 = ActiveWorkbook.Name Windows(ArqAberto02).Activate CAMINHO = Workbooks(ArqAberto02).Path ArqAberto02 = ActiveWorkbook.Name Windows(ArqAberto02).Close Windows(ArqAberto01).Activate Sheets("MENU").Select Set rng = Sheets("MENSAGEM").Range("A1:L22").SpecialCells(xlCellTypeVisible) On Error Resume Next With OutMail .To = Sheets("CAMINHO").Range("B4").Value .CC = Sheets("CAMINHO").Range("B5").Value .BCC = "" .Subject = "OS - VISTORIA" '.HTMLBody = msg1 & RangetoHTML(rng) .HTMLBody = RangetoHTML(rng) '& Assinatura Set Signature = Account.NewMessageSignature .Attachments.Add ("" & CAMINHO & "\" & ArqAberto02 & "") .display End With SendKeys "^{ENTER}" On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Else End If End Sub Function RangetoHTML(rng As Range) Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") TempWB.Close savechanges:=False Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function

Private Sub CMD_OK_Click() If ComboBox1 = Empty And ComboBox3 = Empty And ComboBox2 = Empty And ComboBox4 = Empty And OPT_GERAL = False Then MsgBox "Escolha uma opção", vbInformation Else Dim EncontraString As String Dim Intervalo As Range Sheets("GERAL").Visible = True If OPT_MASTER = True And ComboBox1 <> Empty Then ' ******* PARCEIRO ******* If CHK_FANTASIA = True Then PDV = Right(ComboBox1, 7) EncontraString = PDV If Trim(EncontraString) <> "" Then With Sheets("GERAL").Range("A:A") Set Intervalo = .Find(What:=EncontraString, _ After:=.Cells(1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False) If Not Intervalo Is Nothing Then Application.Goto Intervalo, True '****************** N_SIRIUS = ActiveCell.Offset(0, 2) N_REABERTURA = ActiveCell.Offset(0, 3) N_REVISITA = ActiveCell.Offset(0, 4) N_TROCA = ActiveCell.Offset(0, 5) N_CAPACITAÇÃO = ActiveCell.Offset(0, 6) Sheets("BASE").Range("L8") = N_SIRIUS Sheets("BASE").Range("O8") = N_TROCA Sheets("BASE").Range("R8") = N_REABERTURA Sheets("BASE").Range("U8") = N_REVISITA Sheets("BASE").Range("AA8") = N_CAPACITAÇÃO Unload FRM_MASTER Sheets("GRAFICO").Select Range("G3") = OPT_MASTER.Caption Range("K3") = ComboBox1 Else MsgBox "Sem informação sobre a Empresa", vbInformation End If End With End If ElseIf CHK_PDV Then PDV = Left(ComboBox1, 7) EncontraString = PDV If Trim(EncontraString) <> "" Then With Sheets("GERAL").Range("A:A") Set Intervalo = .Find(What:=EncontraString, _ After:=.Cells(1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False) If Not Intervalo Is Nothing Then Application.Goto Intervalo, True '****************** N_SIRIUS = ActiveCell.Offset(0, 2) N_REABERTURA = ActiveCell.Offset(0, 3) N_REVISITA = ActiveCell.Offset(0, 4) N_TROCA = ActiveCell.Offset(0, 5) N_CAPACITAÇÃO = ActiveCell.Offset(0, 6) Sheets("BASE").Range("L8") = N_SIRIUS Sheets("BASE").Range("O8") = N_TROCA Sheets("BASE").Range("R8") = N_REABERTURA Sheets("BASE").Range("U8") = N_REVISITA Sheets("BASE").Range("AA8") = N_CAPACITAÇÃO Unload FRM_MASTER Sheets("GRAFICO").Select Range("G3") = OPT_MASTER.Caption Range("K3") = ComboBox1 Else MsgBox "Sem informação sobre a Empresa", vbInformation End If End With End If End If ElseIf OPT_CONSULTOR = True And ComboBox3 <> Empty Then Application.DisplayAlerts = False Sheets("GERAL").Activate Rows("1:1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$Microsoft50000").AutoFilter Field:=12, Criteria1:= _ ComboBox3 Range("L50000").Select Selection.End(xlUp).Select Range(Selection, "A1").Select Selection.Copy Sheets.Add After:=ActiveSheet PLAN02 = ActiveSheet.Name ActiveSheet.Paste Range("C50000").Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select LINHA = 2 POSIÇÃO = ActiveCell.Row 'Application.CutCopyMode = False X = LINHA - POSIÇÃO ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" Sheets("GERAL").Activate Selection.AutoFilter Sheets(PLAN02).Activate Range("C50000").Select Selection.End(xlUp).Select V = ActiveCell.Row Range(Cells(V, 3), Cells(V, 7)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '****************** N_SIRIUS = Cells(V, 3) N_REABERTURA = Cells(V, 4) N_REVISITA = Cells(V, 5) N_TROCA = Cells(V, 6) N_CAPACITAÇÃO = Cells(V, 7) Sheets("BASE").Range("L8") = N_SIRIUS Sheets("BASE").Range("O8") = N_TROCA Sheets("BASE").Range("R8") = N_REABERTURA Sheets("BASE").Range("U8") = N_REVISITA Sheets("BASE").Range("AA8") = N_CAPACITAÇÃO Sheets(PLAN02).Select ActiveWindow.SelectedSheets.Delete Unload FRM_MASTER Sheets("GRAFICO").Select Range("G3") = OPT_CONSULTOR.Caption Range("K3") = ComboBox3 Application.DisplayAlerts = True ElseIf OPT_REG = True And ComboBox2 <> Empty Then Application.DisplayAlerts = False Sheets("GERAL").Activate Rows("1:1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$Microsoft50000").AutoFilter Field:=11, Criteria1:= _ ComboBox2 Range("L50000").Select Selection.End(xlUp).Select Range(Selection, "A1").Select Selection.Copy Sheets.Add After:=ActiveSheet PLAN02 = ActiveSheet.Name ActiveSheet.Paste Range("C50000").Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select LINHA = 2 POSIÇÃO = ActiveCell.Row 'Application.CutCopyMode = False X = LINHA - POSIÇÃO ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" ActiveCell.Offset(0, 1).Select ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & X & "]C:R[-1]C)" Sheets("GERAL").Activate Selection.AutoFilter Sheets(PLAN02).Activate Range("C50000").Select Selection.End(xlUp).Select V = ActiveCell.Row Range(Cells(V, 3), Cells(V, 7)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '****************** N_SIRIUS = Cells(V, 3) N_REABERTURA = Cells(V, 4) N_REVISITA = Cells(V, 5) N_TROCA = Cells(V, 6) N_CAPACITAÇÃO = Cells(V, 7) Sheets("BASE").Range("L8") = N_SIRIUS Sheets("BASE").Range("O8") = N_TROCA Sheets("BASE").Range("R8") = N_REABERTURA Sheets("BASE").Range("U8") = N_REVISITA Sheets("BASE").Range("AA8") = N_CAPACITAÇÃO Sheets(PLAN02).Select ActiveWindow.SelectedSheets.Delete Unload FRM_MASTER Sheets("GRAFICO").Select Range("G3") = OPT_REG.Caption Range("K3") = ComboBox2 Application.DisplayAlerts = True End If Sheets("GERAL").Visible = False Sheets("GRAFICO").Select For i = 1 To 5 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = False Next If Sheets("BASE").Range("X9") >= 9 Then For i = 1 To 5 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = True Next ElseIf Sheets("BASE").Range("X9") >= 7 Then For i = 1 To 4 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = True Next ElseIf Sheets("BASE").Range("X9") >= 5 Then For i = 1 To 3 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = True Next ElseIf Sheets("BASE").Range("X9") >= 3 Then For i = 1 To 2 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = True Next ElseIf Sheets("BASE").Range("X9") >= 1 Then For i = 1 To 1 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = True Next ElseIf Sheets("BASE").Range("X9") = 0 Then For i = 1 To 5 ActiveSheet.Shapes.Range(Array("Picture " & i + 31)).Visible = False Next End If Application.DisplayAlerts = True Sheets("GRAFICO").enable = True End If End Sub adicionado 4 minutos depois @Kelvim Eu testei colocar o comando para selecionar a plan no final do codigo e funcionou ele parou de travar a movimentação. ele não estava deixando movimentar com o cursor. valeu adicionado 7 minutos depois @Kelvim Coloquei dentro do botão a opção de selecionar a plan. E voltou a travar ele não deixar navegar. Acredito que alguma parte do codigo esteja travando a plan para as setas navegarem

Bom dia Tem um código de VBA excel. Ele roda direito. O problema que quando tento mover a seleção entre as células usando as setas, ele trava como se tivesse bloqueado. Como devo proceder.

Boa tarde Estou fazendo uma formatação condicional com objetos. Configuro a imagem do tamanho que desejo. porém quando reinicia o EXCEL a imagem fica de um tamanho menor. Gostaria de saber como deixo o tamanho fixo. Att

Boa tarde Meu nome é Kelvim. Gostaria de saber se alguém conhece algum código que faça um teste de ping ao mesmo tempo salve o arquivo no formato de PDF. Ou ate mesmo salve em TXT depois converta em PDF. Cheguei no comando abaixo. porém não conseguir coloca para salvar em PDF nem converter. DEU CERTTO ping www.google.com.br >teste.txt NÃO DEU CERTO ping www.google.com.br >teste.pdf

Boa tarde Gostaria de saber se alguém sabe como posso através de uma Macro na pasta de trabalho01 colocar senha no VBAProject de outra pasta de Trabalho02 do excel. Até cheguei no código abaixo porém não conseguir ir alem. Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute Atenciosamente

Descobri como resolver basta usar a propriedade VBAProject.EstaPasta_de_trabalho Para colocar senha na criptografia basta usar a opção acima. Agora gostaria de saber se alguem sabe como eu posso atraves do VBA colocar senha no VBAproject de outra pasta de trabalho

Boa noite Meu nome é Kelvim. Gostaria de saber se alguém sabe salvar um arquivo criptografado através do VBA. Atenciosamente adicionado 0 minutos depois @BasoleBoa noite Gostaria de pedir sua ajuda. Será que você saberia algo a respeito? adicionado 19 minutos depois Descobri como resolver basta usar a propriedade VBAProject.EstaPasta_de_trabalho