Basole

@seomar reisenvie um exemplo bem simples da sua planilha com dados e imagens ficticias para ter uma ideia melhor do que precisa.

Bom eu nunca testei isso, mas se no BD você criar uma macro que atualiza as planilhas, por exemplo "Update_FrontEnd". E da planilha que está fazendo a alteração, chamar a macro: Ex.: Dim strDatabasePath As String Dim appAccess as object Set appAccess = VBA.CreateObject("Access.Application") strDatabasePath = "C:\Users\Usuaro\Desktop\BD.accdb" With appAccess .OpenCurrentDatabase strDatabasePath .Run "Update_FrontEnd" .Quit End With Set appAccess = Nothing Edit.: No Banco de Dados criar a macro que atualiza planilhas. Exemplo: Public Function Update_FrontEnd() Dim sql As String Dim icol As Long Dim rs As Recordset Dim objExcel As Object Dim sh As Object Set objExcel = CreateObject("Excel.Application") ' abre a pasta de trabalho Set objExcel = VBA.GetObject("C:\Users\usuario\Desktop\Arquivo\Pasta_de_trabalho.xlsm") Set sh = objExcel.Worksheets("Bancodedados") 'seta a aba sql = "SELECT * from Sua_Tabela" On Error GoTo Error_Qr Set rs = CurrentDb.OpenRecordset(sql) On Error GoTo 0 If Not rs.EOF Then ' add nome dos campos do bd For icol = 0 To rs.Fields.Count - 1 sh.Cells(1, icol + 1).Value = rs.Fields(icol).Name Next sh.Cells(2, 1).CopyFromRecordset rs ' cola os dados sh.Cells.EntireColumn.AutoFit objExcel.Close saveChanges:=True Set rs = Nothing Set sh = Nothing End If Exit Function Error_Qr: MsgBox "Error: " & Err.Description, vbCritical Exit Function End Function

Quando um sistema faz a alteração no BD, não poderia atualizar os demais. Sem precisar da interação do BD ?

@samara.vbabom dia, Acredito que voce já tenha um codigo para selecionar a foto. De qualquer forma pode adaptar ao exemplo abaixo: Sub Botao_Salvar() Dim fd As Office.FileDialog Dim strFile As String Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker) With fd .Filters.Clear .Filters.Add "Arquivos de Imagens", "*.jpg", 1 .Title = "Selecione uma imagem" .AllowMultiSelect = False .InitialFileName = VBA.Environ("USERPROFILE") & "\Desktop" If .Show = True Then strFile = .SelectedItems(1) End If End With With Worksheets("Plan1") .Cells(.Cells(Rows.Count, 2).End(xlUp).Offset(1).Row, 2).Value = VBA.Environ("USERPROFILE") .Cells(.Cells(Rows.Count, 3).End(xlUp).Offset(1).Row, 3).Value = VBA.Replace(strFile, VBA.Environ("USERPROFILE"), "") End With End Sub

@samara.vba entendi agora. Deixa eu ver aqui..... @samara.vba fiz um exemplo aqui, veja se é isso... ....sempre vai salvar na próxima linha vazia Sub Botao_Salvar() With Worksheets("Plan1") .Cells(.Cells(Rows.Count, 2).End(xlUp).Offset(1).Row, 2).Value = VBA.Environ("USERPROFILE") .Cells(.Cells(Rows.Count, 3).End(xlUp).Offset(1).Row, 3).Value = "\Desktop\programa\foto1.jpg" End With End Sub

Você pode colocar um comando para quando abrir a Pastade_Trabalho, automaticamente, já inserir o caminho na celula [ C1 ], por exempo: Em um módulo padrão: Sub Auto_Open() With Worksheets("Plan1") .Range("C1").Value = VBA.Environ("USERPROFILE") & _ "\Desktop\Excel\" & Range("A1").Value & ".jpg" End With End Sub Não sei é isso exatamente, que que está se referindo...

@samara.vba bom dia ! Voce pode concatenar os dados junto com a função (udf), abaixo para retornar o usuário da máquina atual: Exemplo: Na célula B1 => =Usuario() & "\desktop\excel\" &A1& ".jpg" A função abaixo cole em um mólulo padrão: Function Usuario() Usuario = VBA.Environ("USERPROFILE") End Function

@samara.vbanão entendi sua questão

Essas consultas do google mps, já não são mais possivel, sem a API Key.

@Iury Frutuososeria bom se enviasse uma amostra dos seus dados c/ o resultado desjado

@samara.vba use a funcao environ Exemplo: Sub Teste_Usuario() MsgBox vba.Environ("USERPROFILE") & "\Desktop\pasta x\fotos\01.jpg" End Sub

Poste o arquivo TXT que está importando

@Luan Valle sim coloque o link de download da planilha, fica mais fácil as pessoas entenderem, e lhe ajudar.

@danielgomesrj@gmail.com experimente colocar + duas aspas entre o caminho Exemplo: RetVal = Shell("""C:\Sistemas\NomePrograma_Zero\NomePrograma.BAT""", 1)

Fiz as alterações,mas não tive como testar, Veja se é isso e de retorno por favor. Sub Importar() Dim Abrir As String Dim Importarwb As Workbook Dim Importarguia As Worksheet Dim xlObj As Object On Error GoTo trataErro Set xlObj = CreateObject("excel.application") Abrir = Application.GetOpenFilename( _ FileFilter:="Arquivo do Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Escolha o arquivo a ser importado") Set Importarwb = xlObj.Workbooks.Open( _ Filename:=Abrir, Password:="123") Set Importarguia = Importarwb.Worksheets(1) Application.ScreenUpdating = False 'Desbloquear guia e pasta de trabalho ThisWorkbook.Unprotect ("123") ActiveSheet.Unprotect ("123") 'Copiar dados Importarguia.UsedRange.Copy 'Limpar guia "Relatório" e colar dados ThisWorkbook.Worksheets("Relatório").Visible = True With Worksheets("Relatório") .Activate .Range(.Cells(1, 1), .Cells(10000, 90)).ClearContents .Cells(1, 1).Select .Paste .Visible = False End With Importarwb.Application.CutCopyMode = False 'Fechar arquivo externo If Not Importarwb Is Nothing Then Importarwb.Close False Set Importarwb = Nothing Set xlObj = Nothing End If 'Bloquear guia e pasta de trabalho ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=False Sheets("Base de Contratos").Protect Password:="123", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ UserInterfaceOnly:=True, _ AllowFormattingCells:=False, _ AllowFormattingColumns:=False, _ AllowFormattingRows:=True, _ AllowInsertingColumns:=False, _ AllowInsertingRows:=True, _ AllowInsertingHyperlinks:=False, _ AllowDeletingColumns:=False, _ AllowDeletingRows:=True, _ AllowSorting:=False, _ AllowFiltering:=True, _ AllowUsingPivotTables:=False trataErro: Application.ScreenUpdating = True If Not Importarwb Is Nothing Then Importarwb.Close False Set Importarwb = Nothing Set xlObj = Nothing End If MsgBox "Relatório importado com sucesso!" End Sub

Segue un link com codigos e exemplos: http://www.onlinepclearning.com/add-previous-and-next-buttons-userform-excel-vba/#Userform_Previous_and_Next_Buttons

Seria bom se pudesse anexar seu arquivo ou um exemplo próximo dele com alguns dados fictícios, para tentar entender melhor o que está acontecendo.

Godinho VBA, post seu arquivo, ou um exemplo com alguns dados ficticios

Repare nesta linha do codigo -> linhalistbox = linhalisbox + 1 -> faltou um "t" (letra t) no segundo linhalistbox. Isto que esta causando o erro. Outra coisa, eu não gosto de usar Do Until = "" pois se por exemplo o loop encontar alguma linha vazia ele é encerrado e na carragar as demais linhas com dados. Fiz algumas alteraçoes: Sub Filtro_Acumulado() Dim UL As Long, linhalisbox As Integer linha = 1 With Me.LBOrcadoRealizado .ColumnCount = 4 .Clear .ColumnWidths = "80;70;70;80" With Sheets("BANCO_DE_DADOS") UL = .Cells(Rows.Count, 1).End(xlUp).Row End With For linha = linha To UL If Sheets("BANCO_DE_DADOS").Cells(linha, 1) <> "" Then .AddItem .List(linhalistbox, 0) = Sheets("BANCO_DE_DADOS").Cells(linha, 1) .List(linhalistbox, 1) = Sheets("BANCO_DE_DADOS").Cells(linha, 2) .List(linhalistbox, 2) = Sheets("BANCO_DE_DADOS").Cells(linha, 3) .List(linhalistbox, 3) = Sheets("BANCO_DE_DADOS").Cells(linha, 4) linhalistbox = linhalistbox + 1 'soma ela mesma, pula para próxima linha End If Next End With End Sub

Para que o evento seja acionado por alterações de valores com formulas, use o evento calculate. Veja o exemplo: Em um modulo padrão, declare as variaveis: Public iniVal1 As Variant Public iniVal2 As Variant Em qualquer celula coloque uma formula, por exemplo: em B1: =A1+1 Private Sub Worksheet_Calculate() If Range("H2").Value <> iniVal1 Or _ Range("H3").Value <> iniVal2 Then Application.EnableEvents = True Call CLASSIFICAÇÃOCALCULORS iniVal1 = Range("H2").Value iniVal2 = Range("H3").Value Application.EnableEvents = False End If End Sub

Poste aqui o seu modelo

Olá Mina seja bem vinda abordo! Pelo que estou vendo a celula "F2" já esta calculando o total, correto? Caso seja isso, então insira no evento Initialize : Private Sub UserForm_Initialize() Me.TextBox1.Text = Sheets("Nome_da_sua_Planilha(aba)").Range("F2").Value End Sub

Com certeza. A opcao vc. enviar os links dos download e solicitar a ela instalar a nova linguagem.

Elaine dee uma olhada neste link : https://support.office.com/en-us/article/Using-the-Speak-feature-with-Multilingual-TTS-e522a4f2-37cb-492b-be6a-8997d23dfe70

Tente usar as " [ ] " ex.: [Desc Local de Trabalho]