Gerar nova planilha...
 
Notifications
Clear all

[Resolvido] Gerar nova planilha com código interno VBA na nova planilha gerada.

6 Posts
3 Usuários
2 Likes
2,496 Visualizações
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

Fala galera

Estou com o seguinte problema:

 

Preciso gerar uma planilha a partir de outra com os mesmos dados (até aqui ok!), porém preciso que a nova planilha seja salva no formato .xlsm contendo alguns códigos específicos que envolvem Target e Intersect, para imposição de algumas regras de preenchimento em intervalo determinado, como por exemplo: "não sobrescrever títulos de colunas, não permite preenchimento fora fora do intervalo definido"...

Ainda não tenho modelo desenvolvido, estou aguardando encontrar algum insight de como fazer... se alguém conseguir indicar algum artigo fico agradecido (não fui muito feliz na pesquisa, ainda..rs).

Problema aqui é só como salvar em .xlsm nova planilha que contenha código interno VBA.

 

Desde já fico muito agradecido!!

 

 

 

 

 
Postado : 31/07/2021 8:15 pm
Tags do Tópico
(@mprudencio)
Posts: 2749
Famed Member
 

Este codigo salva um arquivo com o formato xlsm.

Todos os codigos que existirem no arquivo original, serão levados ao novo arquivo.

Sub GravarComMacro()

ChDir "C:\Users\Usuario\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Usuario\Desktop\copiar dados e formatação.2.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 01/08/2021 7:54 pm
AMORIM123 reacted
(@teleguiado)
Posts: 142
Estimable Member
 

Adaptei o código abaixo desse site para exportar alguns módulos que precisava.

 

Public Sub ExportModules()
    Dim bExport As Boolean
    Dim wkbSource As Excel.Workbook
    Dim szSourceWorkbook As String
    Dim szExportPath As String
    Dim szFileName As String
    Dim cmpComponent As VBIDE.VBComponent

    ''' The code modules will be exported in a folder named.
    ''' VBAProjectFiles in the Documents folder.
    ''' The code below create this folder if it not exist
    ''' or delete all files in the folder if it exist.
    

    If FolderWithVBAProjectFiles = "Error" Then
        MsgBox "Export Folder not exist"
        Exit Sub
    End If
    
    On Error Resume Next
        Kill FolderWithVBAProjectFiles & "\*.*"
    On Error GoTo 0

    ''' NOTE: This workbook must be open in Excel.
    szSourceWorkbook = ActiveWorkbook.Name
    Set wkbSource = Application.Workbooks(szSourceWorkbook)
    
    If wkbSource.VBProject.Protection = 1 Then
    MsgBox "The VBA in this workbook is protected," & _
        "not possible to export the code"
    Exit Sub
    End If
    
    szExportPath = FolderWithVBAProjectFiles & "\"
    
    For Each cmpComponent In wkbSource.VBProject.VBComponents
'    For Each vbext_ct_StdModule In wkbSource.VBProject.VBComponents
        
        bExport = True
        szFileName = cmpComponent.Name
        If szFileName = "Extenso" Or szFileName = "cCalendar" Or szFileName = "DatePickerForm" Then
        
        ''' Concatenate the correct filename for export.
        Select Case cmpComponent.Type
            Case vbext_ct_ClassModule
                szFileName = szFileName & ".cls"
                bExport = True
            Case vbext_ct_MSForm
                szFileName = szFileName & ".frm"
                bExport = True
            Case vbext_ct_StdModule
                szFileName = szFileName & ".bas"
                bExport = True
            Case vbext_ct_Document
                ''' This is a worksheet or workbook object.
                ''' Don't try to export.
                bExport = False
        End Select
        
        If bExport Then
            ''' Export the component to a text file.
            cmpComponent.Export szExportPath & szFileName
      End If
        ''' remove it from the project if you want
        '''wkbSource.VBProject.VBComponents.Remove cmpComponent
   '      End If
        
        End If
   
'    Next vbext_ct_StdModule
    Next cmpComponent

'    MsgBox "Export is ready"
End Sub

Public Sub ImportModules()
    Dim wkbTarget As Excel.Workbook
    Dim objFSO As Scripting.FileSystemObject
    Dim objFile As Scripting.File
    Dim szTargetWorkbook As String
    Dim szImportPath As String
    Dim szFileName As String
    Dim cmpComponents As VBIDE.VBComponents

    If ActiveWorkbook.Name = ThisWorkbook.Name Then
        MsgBox "Select another destination workbook" & _
        "Not possible to import in this workbook "
        Exit Sub
    End If

    'Get the path to the folder with modules
    If FolderWithVBAProjectFiles = "Error" Then
        MsgBox "Import Folder not exist"
        Exit Sub
    End If

    ''' NOTE: This workbook must be open in Excel.
    szTargetWorkbook = ActiveWorkbook.Name
    Set wkbTarget = Application.Workbooks(szTargetWorkbook)
    
    If wkbTarget.VBProject.Protection = 1 Then
    MsgBox "The VBA in this workbook is protected," & _
        " not possible to Import the code"
    Exit Sub
    End If

    ''' NOTE: Path where the code modules are located.
    szImportPath = FolderWithVBAProjectFiles & "\"
        
    Set objFSO = New Scripting.FileSystemObject
    If objFSO.GetFolder(szImportPath).Files.Count = 0 Then
       MsgBox "There are no files to import"
       Exit Sub
    End If

    'Delete all modules/Userforms from the ActiveWorkbook
 '   Call DeleteVBAModulesAndUserForms

    Set cmpComponents = wkbTarget.VBProject.VBComponents
    
    ''' Import all the code modules in the specified path
    ''' to the ActiveWorkbook.
    For Each objFile In objFSO.GetFolder(szImportPath).Files
    
        If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
            (objFSO.GetExtensionName(objFile.Name) = "frm") Or _
            (objFSO.GetExtensionName(objFile.Name) = "bas") Then
            cmpComponents.Import objFile.Path
    
    
'        If (objFSO.GetExtensionName(objFile.Name) = "bas") Then
'            cmpComponents.Import objFile.Path
        End If
        
    Next objFile
    
'    MsgBox "Import is ready"
End Sub

Function FolderWithVBAProjectFiles() As String
    Dim WshShell As Object
    Dim FSO As Object
    Dim SpecialPath As String

    Set WshShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("scripting.filesystemobject")

    SpecialPath = WshShell.SpecialFolders("MyDocuments")

    If Right(SpecialPath, 1) <> "\" Then
        SpecialPath = SpecialPath & "\"
    End If
    
    If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
        On Error Resume Next
        MkDir SpecialPath & "VBAProjectFiles"
        On Error GoTo 0
    End If
    
    If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
        FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
    Else
        FolderWithVBAProjectFiles = "Error"
    End If
    
End Function

Function DeleteVBAModulesAndUserForms()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        
        Set VBProj = ActiveWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                'Thisworkbook or worksheet module
                'We do nothing
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
End Function

Obrigado.

Teleguiado.
E-mail: telegui4do@gmail.com

 
Postado : 02/08/2021 11:09 am
AMORIM123 reacted
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

@mprudencio Vlw meu brother ..pela contribuição, vou avaliar

 
Postado : 02/08/2021 7:33 pm
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

@teleguiado Muito Obrigado chapa...vou estudar para vê se cabe pra mim.

 
Postado : 02/08/2021 7:34 pm
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

Saudações meus caros!

Consegui resolver o meu problema a cima e gostaria de compartilha com vc's e com outras pessoas que no futuro talvez necessitem da mesma solução; seguinte:

Basicamente adaptei os códigos dessa página às minhas necessidades, LINK.

Antes vc tem que ir, no excel, em OPÇÕES → CENTRAL DE CONFIABILIDADE → CONFIGURAÇÕES DA CENTRAL DE CONFIABILIDADE → CONFIGURAÇÕES DE MACRO → FLEGAR A OPÇÃO: "CONFIAR NO ACESSO  AO MODELO DE OBJETO DE PROJETO DO VBA".

Também tem que, no ambiente do VB Editor, ir em: FERRAMENTAS → REFERÊNCIAS → FLEGAR A OPÇÃO: "Microsoft Visual Basic for Application Extensibility 5.3"

Feito isso ao implementar o código do link no meu projeto, devidamente adaptado, ficou assim:

 

Public Sub Add_Event_Planilha1()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long

Dim arrRng As Variant
Dim i As Long
Dim UltLine As Integer


Set VBProj = ActiveWorkbook.VBProject
'O código que eu queria inserir no módulo da "Planilha1 (nome VBA da planilha)" estava
'no intervalo (arrRng) da Sheet da Workbook de origem (eu tenho uma workbook que criava 'outra!).
Set VBComp = VBProj.VBComponents("Planilha1")
Set CodeMod = VBComp.CodeModule

With Wsh_NModule

'Definição do intervalo que contém o código que quero inserir5
UltLine = .Cells(Rows.Count, 1).End(xlUp).Row
arrRng = .Range(.Cells(1, 1), .Cells(UltLine, 1))

'Aqui eu itero entre as linhas do intervalo
For i = LBound(arrRng) To UBound(arrRng)

LineNum = CodeMod.CountOfLines + 1
'Aqui insiro cada linha do intervalo no módulo da "Planilha1"
CodeMod.InsertLines LineNum, arrRng(i, 1)
LineNum = LineNum + 1

Next i

End With

End Sub

 

A minha necessidade inicial era criar um módulo em outra workbook, mas como se tratava de eventos de planilha e de workbook, então não houve necessidade de criação do módulo, pois inserir diretamente em EstaPastaDeTrabalho e Planilha1. Porém, antes acabei sim, inserindo o código para criação de módulo do link e também rodou tranquilamente.

 

 
Postado : 10/08/2021 8:50 am