Ir ao conteúdo
  • Cadastre-se
Fernando Spinelli

Macro para numerar arquivos

Recommended Posts

Olá pessoal estou precisando de uma macro para numeras arquivos do excel, vou dar um exemplo, pois na realidade são 360 hahaha, tenho 10 pasta cada uma com um arquivo ".xlsx" dentro. Preciso que a macro abra o arquivo ".xlsx" da pasta 1 coloque numero 1 em uma determinada célula feche o arquivo, abra o arquivo ".xlsx" da pasta 02 escreva o numero 2 em uma determinada célula e feche, e assim por diante.

O resultado final esperado é "Pagina 01/10"

O resultado final esperado é "Pagina 02/10"

Quem souber de algo que me ajude agradeço.

Compartilhar este post


Link para o post
Compartilhar em outros sites

No nome do arquivo nao é possivel usar "/"

 

Se os arquivos estiverem tudo em uma unica pasta é possivel renomear os arquivos como você deseja mas sem a "/" pode se substituir por "-" ou outro caractere qualquer.

 

Tenho pra mim que os arquivos são "iguais", não é mais fácil juntar tudo em um unico arquivo?

 

Depois basta formatar a planilha de acordo com as paginas.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Então o nome do arquivo não seria alterado, e sim uma determinada célula do arquivo. Pela função  dos aquivos não e possível juntar tudo em um só.

Vou dar um exemplo pra ver se fica mais claro, é como se fosse um livro onde cada pagina é um arquivo do excel.

Como é um processo que ocorre varias vezes queria achar um jeito de não teque juntar todos arquivos em uma pasta. Fiz uma macro que numera as paginas porém tenho que juntar tudo em uma unica pasta ai utilizo a função "DIR" do VBA para abrir cada arquivo e fazer as alterações, gostaria de apenas eliminar essa etapa de juntar tudo em uma pasta.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Disponibilize alguns arquivos para entender o formato do arquivo.

 

 

Uma pergunta qual o criterio sera usado para numerar os arquivos?

 

Afinal eles devem ter uma sequencia.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Então atualmente o critério de numeração está sendo a ordem que os arquivos estão na pasta (vou disponibilizar o código no post), porém como quero eliminar essa etapa de colocar tudo em uma pasta só penso em utilizar o nome do arquivo como critério pois o nome dos arquivos são ex. TT 0001, TT 0002, TT 0003 e assim por diante.

 

O modelo do arquivo a ser numerado são todos "iguais" alguns tem 4 sheets outros 5,  as vezes a celula que deve conter a numeração muda de local de um sheet para o outro por isso fiz um "IF" para testar.

 

Sub numeratudo2()


Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim pgtotal As Integer
Dim folha As Integer
Dim data As String
Dim relatorio As String

I = 1
folha = 1
pgtotal = 0

' ENTRADA DE DADOS

MyFolder = InputBox("Digite o local dos arquivos a serem numerados", "Local dos arquivos", "C:\")
data = InputBox("Digite a data para ser inserida nos arquivos, caso não tenha deixe em branco", "Data relatório", "27/04/2017")
relatorio = InputBox("Digite o numero do relatorio", "Digite abaixo o numero do relatório para ser inserido as folhas", "0000010")

'FIM ENTRADA DE DADOS


MyFile = Dir(MyFolder & "\*.xlsx")
'CONTAGEM DAS PAGINAS
Do While MyFile <> ""

Workbooks.Open Filename:=MyFolder & "\" & MyFile

 S = Sheets().Count
 
 pgtotal = pgtotal + S

 Windows(MyFile).Close (False)
   
MyFile = Dir

Loop
'!!SEGUNDA ETAPA
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""

Workbooks.Open Filename:=MyFolder & "\" & MyFile
Z = Sheets.Count

Do While I <= Z

    Sheets(I).Select
    ActiveWindow.Zoom = 100
    If Range("I1") = "FOLHA" Then
    Range("I2").Select
    ActiveCell.NumberFormat = "@"
    Selection.Font.Bold = False
    With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = folha & "/" & pgtotal
    Else
    Range("N1").Select
    ActiveCell.NumberFormat = "@"
    Selection.Font.Bold = False
    With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
    End With
    ActiveCell.FormulaR1C1 = folha & "/" & pgtotal
    End If
    Sheets(I).Name = "Folha " & folha & "-" & pgtotal
    folha = folha + 1
    I = I + 1
       
    Loop
Sheets(1).Select
Range("C6").FormulaR1C1 = relatorio
Range("c6").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
Range("I4").FormulaR1C1 = data
Windows(MyFile).Close (True)
I = 1
MyFile = Dir
Loop

Application.ScreenUpdating = True
MsgBox ("Arquivos numerados")

End Sub

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×