[b]Private Sub Image2_Click()

 With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "SELECIONE UM ARQUIVO"
    If .Show Then
        strpath = .SelectedItems(1)
        Else
        strpath = ""
    End If
  End With
  TP.Range("AE100000").FormulaR1C1 = strpath
  Me.Image1.Picture = LoadPicture(strpath)

End Sub[/b]


    Private Sub UserForm_Initialize()
    Dim TWB As Variant
    Dim strpath As String
    TWB = ThisWorkbook.Name
    'TWB.Activate
    
    UserForm1.CommandButtonGerar.Enabled = False
    Dim ultimaLin As Long, area As New Collection
    Dim Value As Variant, temp() As Variant
    Dim Value2 As Variant, temp2() As Variant
    Dim Value3 As Variant, temp3() As Variant
    Dim Value4 As Variant, temp4() As Variant
    Dim arr, arr2, arr3 As Variant
    
'Definindo o Valor das Variaveis
    arr = Array("SIM", "NÃO")
arr3 = Array("SIM", "NÃO")
'Definindo o Valor das Variaveis
    arr2 = Array("0", "1", "2")
    
    On Error Resume Next
    'A linha abaixo identifica a última linha
    ultimaLin = Worksheets("Lista_ComboBoxs").Range("B" & Rows.Count).End(xlUp).Row
    'A linha abaixo refere-se a coluna que contém os dados da lista
    'REQUISITANTES
    temp = Worksheets("Lista_ComboBoxs").Range("A2:A" & ultimaLin).Value
    For Each Value In temp
    If Len(Value) > 0 Then area.Add Value, CStr(Value)
    Next Value
    For Each Value In area
    'Adicionando item ao ComboBox
    ComboBoxRequisitante.AddItem Value
    Next Value
    Set area = Nothing
    'SOLICITANTES
    temp2 = Worksheets("Lista_ComboBoxs").Range("B2:B" & ultimaLin).Value
    For Each Value2 In temp2
    If Len(Value2) > 0 Then area.Add Value2, CStr(Value2)
    Next Value2
    For Each Value2 In area
    'Adicionando item ao ComboBox
    ComboBoxSolicitante.AddItem Value2
    Next Value2
    Set area = Nothing
    'APLICAÇÃO
    temp3 = Worksheets("Lista_ComboBoxs").Range("c2:c" & ultimaLin).Value
    For Each Value3 In temp3
    If Len(Value3) > 0 Then area.Add Value3, CStr(Value3)
    Next Value3
    For Each Value3 In area
    'Adicionando item ao ComboBox
    ComboBoxAplicação.AddItem Value3
    Next Value3
    Set area = Nothing
    'UNIDADE
    temp4 = Worksheets("Lista_ComboBoxs").Range("D2:D" & ultimaLin).Value
    For Each Value4 In temp4
    If Len(Value4) > 0 Then area.Add Value4, CStr(Value4)
    Next Value4
    For Each Value4 In area
    'Adicionando item ao ComboBox
    ComboBoxUnidade.AddItem Value4
    Next Value4
    Set area = Nothing
    
    'Definindo a lista da combobox
    Me.ComboBoxOrçamento.List = arr
    
    'Colocando a Data Atual
    TextBoxDataSolicitação = DateValue(Now)
    
    'Definindo a lista da combobox
    Me.ComboBoxPrioridade.List = arr2
    
    

'Cabeçalho ListBox1

With ListBox1
     .AddItem
     .List(0, 0) = "COD ITEM"
     .List(0, 1) = "DESCRIÇÃO"
     .List(0, 4) = "VALOR UNIT"
     .List(0, 3) = "QUANT"
     .List(0, 5) = "VALOR TOTAL"
     .List(0, 2) = "UN"
     ' (linha , coluna)
     
End With
TP.Range("G15").Activate
    End Sub

Private Sub TextBoxOm_Change()
'Definindo o Limite de caracteres

Me.TextBoxOm.MaxLength = 12

End Sub
Private Sub TextBoxRecebedor_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Definindo que a caixa de texto aceitará somente caracteres maiusculos
'KeyAscii = Asc(UCase(Chr(KeyAscii)))

End Sub
Private Sub CmbSair_Click()
Unload Me
Application.Visible = True
ThisWorkbook.Close SaveChanges:=False
End Sub

Private Sub CommandButtonAddItem_Click()
 If TextBoxValorUnit.Value = "" Then
            strVazia = "VALOR UNITÁRIO!!!"
                MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                TextBoxValorUnit.SetFocus
        
        ElseIf TextBoxQuantidade.Value = "" Then
            strVazia = "CENTRO DE CUSTO"
                MsgBox (strVazia & " EM BRANCO"), vbCritical, Msg
                TextBoxQuantidade.SetFocus
        
        ElseIf TextBoxCodItem.Value = "" Then
                strVazia = "CODIGO DO ITEM"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxCodItem.SetFocus
            
         ElseIf TextBoxDescriçãoItem.Value = "" Then
                strVazia = "DESCRIÇÃO DO ITEM!!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxDescriçãoItem.SetFocus
Else
strpath = TP.Range("AE100000").Value
r = ActiveCell.Row
TP.Range("G" & r).Select
TP.Shapes.AddPicture(strpath, msoCTrue, msoCTrue, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
ActiveCell.Offset(1, 0).Select
With ListBox1
     .AddItem
     .List(ListBox1.ListCount - 1, 0) = TextBoxCodItem.Value
     .List(ListBox1.ListCount - 1, 1) = TextBoxDescriçãoItem.Value
     .List(ListBox1.ListCount - 1, 4) = TextBoxValorUnit.Value
     .List(ListBox1.ListCount - 1, 3) = TextBoxQuantidade.Value
     .List(ListBox1.ListCount - 1, 5) = TextBoxValorTotalAprox
     .List(ListBox1.ListCount - 1, 2) = ComboBoxUnidade.Value
End With
TextBoxCodItem = ""
TextBoxDescriçãoItem = ""
TextBoxValorUnit = ""
TextBoxQuantidade = ""
TextBoxValorTotalAprox = ""
ComboBoxUnidade = ""
Image1.Picture = LoadPicture("")
Call somartotal

End If
End Sub

Private Sub CommandButtonGerar_Click()
Application.ScreenUpdating = False

Dim Data As Date
Dim Prioridade As Double
Dim Custo As Double

Prioridade = ComboBoxPrioridade.Value
Custo = TextBoxCentrodeCusto.Value
Om = TextBoxOm.Value
Data = TextBoxEntrega.Value

Sheets("TEMPLATE").Range("b5") = ComboBoxRequisitante
Sheets("TEMPLATE").Range("b6") = ComboBoxSolicitante
Sheets("TEMPLATE").Range("b7") = ComboBoxAplicação
Sheets("TEMPLATE").Range("b8") = TextBoxRecebedor
Sheets("TEMPLATE").Range("b9") = TextBoxFornecedor
Sheets("TEMPLATE").Range("b10") = Om
Sheets("TEMPLATE").Range("c11") = TextBoxJustificativa
Sheets("TEMPLATE").Range("c13") = CCur(TextBoxValorTotalBruto)
Sheets("TEMPLATE").Range("d5") = CDate(TextBoxDataSolicitação)
Sheets("TEMPLATE").Range("d6") = Format(Data, DDMMYYYY)
Sheets("TEMPLATE").Range("d7") = Prioridade
Sheets("TEMPLATE").Range("d8") = ComboBoxOrçamento
Sheets("TEMPLATE").Range("d10") = ComboBoxEng
Sheets("TEMPLATE").Range("d9") = Custo




    If ListBox1.ListCount = 0 Then
    MsgBox ("Não há itens a ser gerado"), vbInformation, ("Erro")
    Else
       
    If Sheets("TEMPLATE").Range("A15") = "" Then
    
    Else
    TP.Range("A15").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("TEMPLATE").Range("A15").Select
    End If
    
    Dim item As Double
    Dim linha As Integer
    Dim valor_unit As Double
    Dim Valor_total As Double
    

    linha = 15
    
    For item = 1 To ListBox1.ListCount - 1

    
    Sheets("TEMPLATE").Cells(linha, 1) = ListBox1.List(item, 0)
    Sheets("TEMPLATE").Cells(linha, 2) = ListBox1.List(item, 1)
    Sheets("TEMPLATE").Cells(linha, 6) = CCur(ListBox1.List(item, 5))
   Sheets("TEMPLATE").Cells(linha, 4) = ListBox1.List(item, 3)
    Sheets("TEMPLATE").Cells(linha, 5) = CCur(ListBox1.List(item, 4))
    Sheets("TEMPLATE").Cells(linha, 3) = ListBox1.List(item, 2)
    
    linha = linha + 1
    
    Next
    
    
    End If
Call gerar
Call CmbSair_Click
Application.ScreenUpdating = True
End Sub

Private Sub CommandButtonLimparItens_Click()
ListBox1.Clear
With ListBox1
     .AddItem
     .List(0, 0) = "COD ITEM"
     .List(0, 1) = "DESCRIÇÃO"
     .List(0, 4) = "VALOR UNIT"
     .List(0, 3) = "QUANT"
     .List(0, 5) = "VALOR TOTAL"
     .List(0, 2) = "UN"
     
     
End With
Call somartotal
Call Limpar
End Sub

Private Sub CommandButtonValidarDados_Click()
    Dim Msg
    Msg = "Todos os Campos são de Preenchimento Obrigatório"   ' Define a mensagem
    
    If ComboBoxRequisitante.Value = "" Then
            strVazia = "REQUISITANTE !!!"
                MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                ComboBoxRequisitante.SetFocus
        
        ElseIf TextBoxCentrodeCusto.Value = "" Then
            strVazia = "CENTRO DE CUSTO"
                MsgBox (strVazia & " EM BRANCO"), vbCritical, Msg
                TextBoxCentrodeCusto.SetFocus
        
        ElseIf TextBoxEntrega.Value = "" Then
                strVazia = "DATA DESEJADA PARA ENTREGA"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxEntrega.SetFocus
            
         ElseIf TextBoxFornecedor.Value = "" Then
                strVazia = "FORNECEDOR !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxFornecedor.SetFocus
               
         ElseIf TextBoxJustificativa.Value = "" Then
                strVazia = "JUSTIFICATIVA DA SOLICITAÇÃO !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxJustificativa.SetFocus
                    
                             ElseIf TextBoxOm.Value = "" Then
                strVazia = "NÚMERO DA OM !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxOm.SetFocus
                    
                             ElseIf ComboBoxPrioridade.Value = "" Then
                strVazia = "PRIORIDADE DA SOLICITAÇÃO !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    ComboBoxPrioridade.SetFocus
                             
                             ElseIf TextBoxRecebedor.Value = "" Then
                strVazia = "NOME DO RECEBEDOR DESEJADO !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TextBoxRecebedor.SetFocus
                             
                             ElseIf ComboBoxAplicação.Value = "" Then
                strVazia = "APLICAÇÃO DO MATERIAL/FERRAMENTA !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    TComboBoxAplicação.SetFocus
                             
                             ElseIf ComboBoxOrçamento.Value = "" Then
                strVazia = "EXISTE ORÇAMENTO? !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                    ComboBoxOrçamento.SetFocus
                             
                             ElseIf ComboBoxSolicitante.Value = "" Then
                strVazia = "SOLICITANTE !!!"
                    MsgBox (strVazia & vbCrLf & " EM BRANCO"), vbCritical, Msg
                   ComboBoxSolicitante.SetFocus
                   
       
    Else
    
        UserForm1.CommandButtonGerar.Enabled = True
        MsgBox ("INFORMAÇÕES VALIDADAS, CASO TENHA TERMINADO, FAVOR PRESSIONE O BOTÃO GERAR RELATÓRIO.")

   End If
End Sub

Private Sub Label2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.Visible = True
Sheets("TEMPLATE").Select
Unload Me
End Sub

Private Sub TextBoxCodItem_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub TextBoxDescriçãoItem_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub TextBoxEntrega_Change()
If Len(TextBoxEntrega) = 2 Or Len(TextBoxEntrega) = 5 Then
TextBoxEntrega.Text = TextBoxEntrega.Text & "/"
SendKeys "{End}", True
End If
End Sub

Private Sub TextBoxEntrega_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBoxEntrega.MaxLength = 10

If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
    KeyAscii = 0
End If

End Sub

Private Sub TextBoxFornecedor_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

[b]Private Sub TextBoxJustificativa_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub[/b]
Private Sub TextBoxOm_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBoxOm.Text) < 12 Then

MsgBox "NÚMERO DA OM INCORRETO!!!"

Cancel = True

TextBoxOm.SelStart = 0

TextBoxOm.SelLength = TextBoxOm.TextLength

Else: End If
End Sub

Private Sub TextBoxQuantidade_Change()
If TextBoxQuantidade > "" Then
    TextBoxValorTotalAprox = Format(TextBoxValorUnit * TextBoxQuantidade, "Currency")
Else
TextBoxValorTotalAprox = ""
End If
End Sub

Private Sub TextBoxValorUnit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBoxValorUnit = Format(TextBoxValorUnit, "R$  #,##0.00")
End Sub

Sub somartotal()
Dim contador As Integer
contador = ListBox1.ListCount
Dim soma As Double
soma = 0
For i = 1 To contador - 1
soma = soma + ListBox1.List(i, 5)
Next i
TextBoxValorTotalBruto = Format(soma, "currency")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
        MsgBox "Você não pode fechar esta janela, por favor use o Botão SAIR!!!"
        Cancel = True
    End If
End Sub

Sub gerar()

Sheets("TEMPLATE").Copy
Dim newPath As String
newPath = ThisWorkbook.Path 'Salva na mesma pasta que o arquivo está.
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=newPath & "" & "FORMULÁRIO DE PEDIDO DE COMPRA" & "-" & Format(Now(), "DDMMYYYYHHMM") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
ThisWorkbook.Close SaveChanges:=False
MsgBox "O Formulário foi salvo com Sucesso na pasta! " & ActiveWorkbook.Path, vbInformation, "Protocolo"
End Sub

Galera tenho este codigo vba, algumas partes dele dar erro de copilação quando executo ele no excel 2016 versão 64 bits, e quando fiz foi no excel 2013 versão 32 bits, principalmente as partes em negrito, e não sei o que fazer alguem me dar uma força? e se tiver algumas dicas para economizar memoria me avisem!, desde já agradeço.