Basole

Acho que não é necessario converter. Até onde eu sei, não dá fazer isso com o VBA padrão e pesquisando não encontrei nenhuma bibiloteca gratuita ou open source relacionada que pudesse ler arquivos com essas extensões, somente aplicativos pagos.

@samara.vbase puder enviar um exemplo com uma imagem para tentar entender melhor o que precisa, facilita tentar te ajudar. * Aqui não da pra anexar arquivos do Excel, faça upload no google drive, onedrive, Dropbox, etc e coloque o link aqui.

@samara.vbause o evento mouse move do componente image Exemplo: No Userform1: Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Load UserForm2 With UserForm2 .Image1.Picture = UserForm1.Image1.Picture .Show End With End Sub

Seria um arquivo no formato "*.pst" ?

Veja se ajuda: Sub ObterMsgOutlook() Dim OutlookApp As Outlook.Application Dim OutlookNamespace As Namespace Dim Folder As MAPIFolder Dim OutlookMail As Variant Dim i As Integer Dim cbl As Boolean Const PalavraChave = "Microsoft" ' * Coloque aqui o termo a pesquisar Const ApartirdaData = #1/21/2021# ' * Formato MM/DD/AAAA Set OutlookApp = New Outlook.Application Set OutlookNamespace = OutlookApp.GetNamespace("MAPI") Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox) 'caixa de entrada i = 1 For Each OutlookMail In Folder.Items If InStr(1, OutlookMail.Body, PalavraChave, vbTextCompare) > 0 And _ OutlookMail.ReceivedTime >= ApartirdaData Then If Not cbl Then Range("A1") = VBA.UCase("Assunto") Range("B1") = VBA.UCase("Data Recebimento") Range("C1") = VBA.UCase("Enviado por:") Range("D1") = VBA.UCase("Corpo E-mail") cbl = True End If Range("A1").Offset(i, 0).Value = OutlookMail.Subject Range("B1").Offset(i, 0).Value = OutlookMail.ReceivedTime Range("C1").Offset(i, 0).Value = OutlookMail.SenderName Range("D1").Offset(i, 0).Value = OutlookMail.Body RemoveHTMLTags Range("D1").Offset(i, 0) i = i + 1 End If Next OutlookMail Set Folder = Nothing Set OutlookNamespace = Nothing Set OutlookApp = Nothing End Sub Sub RemoveHTMLTags(xRg As Range) Dim xCell As Range Dim xStr As String Dim xRegEx As RegExp Dim xMatch As Match Dim xMatches As MatchCollection Set xRegEx = New RegExp Application.EnableEvents = False With xRegEx .Global = True .Pattern = "<(""[^""]*""|'[^']*'|[^'"">])*>" End With For Each xCell In xRg xStr = xCell.Value Set xMatches = xRegEx.Execute(xCell.Text) For Each xMatch In xMatches xStr = Replace(xStr, xMatch.Value, "") Next xCell.Value = xStr Next Application.EnableEvents = True End Sub * Marque as Referencias: Microsoft Outlook xx.x Object library Microsoft VBScript Regular Expression 5.5

@Ramiro Isídiopelo que entendi., o nome da nova pasta de trabalho (planilha formato xlsx), tem que ser: "Relatorio V2.xlsx" Segue o codigo com as alterações: Sub SalvarXLSMtoXLSX() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook Sourcewb.Sheets(1).Activate ' Aba 1(altere se neccess.) ActiveSheet.Copy Set Destwb = ActiveWorkbook With Destwb If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End With TempFilePath = "\\fsextrema02\ProgramacaoControleE-commerce\Inteligência de Estoque\Relatório Fluxo de Processo 7017-7006\7017\" TempFileName = "Relatorio V2" With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With With Excel.Application .ScreenUpdating = True .EnableEvents = True End With End Sub

Copia os dados a primeira aba para uma nova pasta de trabalho e salva no formato xlsx Segue exemplo: Sub SalvarXLSMtoXLSX() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook Sourcewb.Sheets(1).Activate ' Aba 1(altere se neccess.) ActiveSheet.Copy Set Destwb = ActiveWorkbook With Destwb If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End With TempFilePath = Application.DefaultFilePath & "\" ' pasta Meus Documentos (altere se necess.) TempFileName = VBA.Split(ThisWorkbook.Name, ".")(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With With Excel.Application .ScreenUpdating = True .EnableEvents = True End With End Sub creditos https://www.rondebruin.nl/win/s5/win001.htm

@samara.vbatem essa este exemplo de TextBox com a lista na ListBox (oculta), só aparece, quando digita algo. E ao encontrar o termo na lista, só dar o ENTER para auto completar o texto encontrado Veja se atende: AutoCompletar_TextBox-ListBox.xlsm EDIT: @samara.vba eu atualizei o arquivo e acrescentei no Listbox, um recurso que, ao selecionar algum item com as setas (sobe e desce), agora é só dar o ENTER para o item já ir para a textbox. segue o novo link: AutoCompletar_TextBox-ListBox.xlsm

@samara.vbasegue um exemplo, veja se atende. TextBox Auto Completar

@samara.vbabom dia, a funcão VBA.Environ("USERPROFILE"), com o parametro USERPROFILE, referência a unidade ( C:, D:, N:, ... Z: etc ) e o USUARIO logado na maquina, por exemplo: C:\maria O que pode fazer, por exemplo, é ao abrir a pasta de trabalho a macro, no auto_open grava em uma celula essa referencia e o demais parametros (subpastas), do local (diretório) da imagem, exemplo: "\Desktop\app\foto\imagem.jpg" Então quando abrir a pasta de trabalho no computador 1 (usuario maria) na celula A1 será registrado o local da imagem como: C:\maria\area de trabalho\app\foto\imagem.jpg" E o mesmo no computador 2 (usuario João) na celula A1 será registrado o local da imagem como: C:\João\area de trabalho\app\foto\imagem.jpg" Feito isso, com esse registro voce pode referenciar esta célula gravada com o caminho(local) da imagem para demais macros que precisam referenciar a imagem Segue o exemplo com o evento auto_open * Cole em um modulo padrão, alterando a planilha (aba) e a range (celula), e o caminho das subpastas, de acordo com o seu cenário: Private Sub Auto_Open() With ThisWorkbook.Worksheets(1) Range("A1").Value = VBA.Environ("USERPROFILE") & "\Desktop\app\foto\imagem.jpg" End With End Sub Qualquer dúvida estou a disposição:

@moi.agrsim é meio trabalhoso automatizar esta tarefa, mas é possível

Já tentou destaforma: Termos = "gasolina,diesel,eletrico" Termos = VBA.Replace(Termos, ",", "+")

@samara.vbasegue abaixo exemplo Considerando que os dados estejam na [ coluna A ] da aba 1 Altere os nomes dos componentes se necessario: Private IsArrow As Boolean Private Sub ComboBox1_Change() Dim i As Long If Not IsArrow Then With Me.ComboBox1 .List = Worksheets(1).Range("A2", Worksheets(1).Cells(Rows.Count, "A").End(xlUp)).Value .ListRows = Application.WorksheetFunction.Min(6, .ListCount) .DropDown If Len(.Text) Then For i = .ListCount - 1 To 0 Step -1 If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i Next .DropDown End If End With End If End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets(1).Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value End Sub Private Sub UserForm_Activate() ComboBox1_Change End Sub

Tente recriar o suplemento. Abra uma nova pasta de trabalho e copie as macros do suplemento para um modulo da nova pasta de trabalho. Entre em suplementos e desmarque-o em questão. Na pasta onde esta salvo o suplemento, exclua, e salve a pasta de trabalho com a extensão *.xlam na referida pasta e feche. Em seguida abra o Excel e marque novamente o suplemento.

Mostre o que voce já fez

Problema com o suplemento (add-in)

Bom, fiz um teste aqui com a função em questão em um modulo padrão. E sem colocar dados na célula A1, retornou => #valor E inserindo um nome de imagem na celula A1, de um diretorio configurado na função, retornou a imagem como esperado. Tente desistalar e re_instalar este suplemento para que ele volte a se comportar como antigamente

Provavelmente está retornando desta forma porque não tem nenhum shape inserido. If oImage Is Nothing Experimente fazer um teste com dados.

Está faltando o nome da imagem na célula envolvida. Repare que retornou o caminho e as extensão da imagem e o nome não.

No codigo do botão salvar do userform Cad_Edt, substitui a linha abaixo Linha = Range("A:A").Find(txidreg.Text, lookat:=1).Row

Tente assim: Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox "Use o Botão Fechar!!!" End If End Sub

Tente tornar visivel somente a janela da pasta de trabalho em questão. Exemplo: Private Sub Workbook_Open() Application.Visible = False ThisWorkbook.Windows(1).Visible = False UserForm1.Show End Sub

@isaac soaresinfelizmente a Microsoft desabilitou o userform nesta sua versão do Excel, no Mac Nas versões anteriores tem está opção

Usar o calendário com a validação, é chover no molhado. Não entendi a sua dúvida (?)

O excel tem dessas coisas, tente inverter a formatação para o formato americano: DataEntradaTxt = VBA.Format(DataEntradaTxt, "mm/dd/yyyy") Ao invés de validar a data, o ideal é um calendario para usuário selecionar a data evitando erros inesperáveis, segue exemplo: https://drive.google.com/file/d/1tYAzuKe3xHVwUntJujHPTcwIeyV4kowU/view?usp=sharing