excel 从旧工作表导入数据到实际工作表,但旧工作表的宏按钮正在复制到,但我无法删除它

xvw2m8pv  于 2023-03-24  发布在  其他
关注(0)|答案(1)|浏览(122)

我需要从旧工作表导入数据(Planilha Teste 1 VBA)到实际工作表(Pasta teste帕拉importar dados de outra planilha),但宏按钮(CADASTRAR)从旧工作表也得到复制,我不知道如何解决它.我使用的VBA代码是这样的:

Sub ImportarDados()
    Dim wb As Workbook 'declara uma variável para o arquivo que será aberto
    Dim planilhaAtual As Worksheet 'declara uma variável para a planilha atual
    Dim planilhaDados As Worksheet 'declara uma variável para a planilha de origem (dados)
    Dim caminhoArquivo As String 'declara uma variável para o caminho do arquivo
    Dim arquivoSelecionado As Variant 'declara uma variável para armazenar o nome do arquivo selecionado
    
    'Mostra uma janela para que o usuário selecione o arquivo externo
    arquivoSelecionado = Application.GetOpenFilename("Arquivos do Excel (.xlsx;.xlsm),.xlsx;.xlsm")
    
    'Se o usuário selecionar um arquivo, carrega o caminho do arquivo no módulo VBA
    If arquivoSelecionado <> False Then 'verifica se o usuário selecionou um arquivo
        caminhoArquivo = arquivoSelecionado 'armazena o caminho do arquivo selecionado
        
        'Abre o arquivo selecionado
        Set wb = Workbooks.Open(caminhoArquivo)
    
        'Defina a planilha atual (onde o código VBA está sendo executado)
        Set planilhaAtual = ThisWorkbook.ActiveSheet 'define a planilha atual como a ativa
    
        'Extrai o nome da planilha de origem
        Set planilhaDados = wb.Worksheets(1) 'Assumindo que a planilha de origem é a primeira na lista
        Dim nomePlanilha As String 'declara uma variável para armazenar o nome da planilha de origem
        nomePlanilha = planilhaDados.Name 'armazena o nome da planilha de origem
        
        'Extrai o intervalo de dados da planilha de origem
        Dim intervaloDados As Range 'declara uma variável para o intervalo de dados
        Set intervaloDados = planilhaDados.Range("A1:BB200") 'Altere o intervalo conforme necessário
        
       For Each obj In planilhaDados.Shapes 'percorre cada objeto (forma) na planilha de origem
    If obj.Type = msoOLEControlObject Then 'verifica se é um botão de comando
        If Not obj.OLEFormat.Object.Name = "CADASTRAR" Then 'verifica se o botão não é o botão da macro original
            obj.Delete 'exclui o botão de comando
        End If
    Else
        obj.Copy 'copia os outros objetos
        planilhaAtual.Paste 'cola os outros objetos na planilha atual
    End If
Next obj

        
        intervaloDados.Copy planilhaAtual.Range("A1") 'copia o intervalo de dados para a planilha atual
    
        'Feche o arquivo que você importou os dados
        wb.Close False 'fecha o arquivo sem salvar
        
        'Mostra uma mensagem informando o nome da planilha de origem e o caminho do arquivo
        MsgBox "Os dados foram importados da planilha " & nomePlanilha & " no arquivo " & caminhoArquivo & "."
    
    End If
    
End Sub

第一个图像来自旧工作表和宏按钮“CADASTRAR”
第二个图像是从实际的工作表后,我打了“ATUALIZAR”按钮,它导入数据从旧的工作表,然后宏按钮“CADASTRAR”从ols表得到粘贴。
我尝试了很多次修改这几行代码,但是没有得到我期望的结果

For Each obj In planilhaDados.Shapes 'percorre cada objeto (forma) na planilha de origem
    If obj.Type = msoOLEControlObject Then 'verifica se é um botão de comando
        If Not obj.OLEFormat.Object.Name = "CADASTRAR" Then 'verifica se o botão não é o botão da macro original
            obj.Delete 'exclui o botão de comando
        End If
    Else
        obj.Copy 'copia os outros objetos
        planilhaAtual.Paste 'cola os outros objetos na planilha atual
    End If
Next obj
ryhaxcpt

ryhaxcpt1#

如果您不希望形状/对象随范围复制:

Application.CopyObjectsWithCells = False
intervaloDados.Copy planilhaAtual.Range("A1")
Application.CopyObjectsWithCells = True

相关问题