Oi Claudinei,
Vi o seu arquivo, tá ficando monstruosa a coisa ali hein? Cuidado cara, dica de programador antigo: Se quer programar, não só faça acontecer com seus códigos (essa parte é fácil, rs) mas procure seguir padrões de programação.
Declarar variáveis, identar código, não abusar do método .Select e dos ActiveCell, ActiveSheet, ActiveWorkbook, etc...
Ok Vamos lá.
Incluí essas linhas no comecinho do seu Workbook_Open
'--Esta é a chamada para meu código - FF--
Call Planilhando.AjustarZoomsDasPlanilhas
'-----------------------------------------
Adicionei um módulo novo chamado, Planilhando, ali coloquei o meu código que é o seguinte:
'força declaração de variáveis
Option Explicit
'impede que funções aqui escritas, apareçam dentro do Inserir Função do Excel
Option Private Module
'força que as coleções utilizadas comecem do índice 1, ao invés de 0
Option Base 1
Public Sub AjustarZoomsDasPlanilhas()
On Error GoTo Finalizar
'declaração de variáveis e objetos
Dim shtSelected As Worksheet
Dim sht As Worksheet
Dim strColunas As String
'Desligando o Refresh de tela, para vc não ver o Excel piscando na hora de rodar o código
Application.ScreenUpdating = False
Set shtSelected = ActiveSheet
'estrutura de repetição, para varrer todas as planilhas
For Each sht In ThisWorkbook.Worksheets
'resolvi q só vou acertar o zoom das planilhas que de fato estiverem visíveis
If sht.Visible = xlSheetVisible Then
'seleciona a planilha da vez
sht.Select
'define quais as colunas da planilha da vez
strColunas = fnDefinirColunas(sht)
'se a string de colunas voltar vazia da função acima, a planilha não terá seu zoom alterado
If strColunas <> "" Then
Call AjustarZoom(sht, strColunas)
End If
End If
Next sht
shtSelected.Select
Set shtSelected = Nothing
Finalizar:
Application.ScreenUpdating = True
End Sub
Public Sub AjustarZoom(ByRef sht As Worksheet, ByVal strColunas As String)
'Declaração de objetos e variáveis
Dim rngSelection As Range
Dim lRow As Long
Dim lCol As Long
'Verificando se a seleção atual é de uma célula (poderia ser uma imagem ou um gráfico, não tratados nesse código)
'Se a seleção for uma célula, registrando que célula é essa no objeto rngSelection
If TypeName(Selection) = "Range" Then Set rngSelection = Selection
With ActiveWindow
'ScrollRow e ScrollCol são propriedades do objeto window, que indicam qual a primeira linha e coluna da janela ativa, sendo vistas pelo Excel, respectivamente.
'Guardei seus resultados atuais nestas variáveis, só para poder recuperá-los mais tarde
lRow = .ScrollRow
lCol = .ScrollColumn
'Alterei os ScrollRow e ScrollCol para 1, garantindo que a primeira célula visível à esquerda é a célula A1
.ScrollRow = 1
.ScrollColumn = 1
'Selecionar de A a J
sht.Range("A1:J1").Select
'Esta é a "mágica" do código. que acerta o zoom para a área selecionada acima
.Zoom = True
'Pronto, tudo feito, agora é hora de recuperar o posicionamento de tela para aonde estava antes
.ScrollRow = lRow
.ScrollColumn = lCol
End With
If Not rngSelection Is Nothing Then
'e pra finalizar, agora que a tela voltou aonde estava, mas com outro zoom, hora de selecionar de volta aquela célula q estava selecionada
rngSelection.Select
'destruindo as referencias ao objeto, em memória.
Set rngSelection = Nothing
End If
'FIM
End Sub
Public Function fnDefinirColunas(ByRef sht As Worksheet) As String
'Declaração de variáveis
Dim lIndex As Long, arrPlanilhas, arrColunas
'Atribuição de matrizes a duas variáveis definidas sem tipo
arrPlanilhas = Array("RESUMO", "Faixa", "Produtividade", "ASD", "BDAlimentadores", "Faixa_")
arrColunas = Array("A13:I13", "A97:M1", "A1:J27", "A1: O1", "A1: CD1", "A97:M1")
'Loop na matriz arrPlanilhas comparando cada um de seus conteúdos com o nome da planilha da vez
For lIndex = 1 To 5
'de o nomes da planilha bater com um conteúdo da matriz arrPlanilhas então
If sht.Name Like arrPlanilhas(lIndex) Then
'pegar o endereço de colunas da matriz arrColunas, que já foi definida com os intervalos na
'mesma ordem da matriz arrPlanilhas
fnDefinirColunas = arrColunas(lIndex)
Exit Function
End If
Next lIndex
'Planilhas não listadas acima, só terão seu zoom alterado se iniciarem-se com "Faixa_"
If VBA.Left(sht.Name, 6) = arrPlanilhas(6) Then
fnDefinirColunas = arrColunas(6)
End If
End Function
Segue também o arquivo com o código implementado.
Qualquer dúvida, é só chamar.
E importante, aquele código Get_Computer_Name tá com pau. Eu nem perdi meu tempo tentando arrumar. Comentei-o, fiz o que eu tinha que fazer, depois o descomentei.
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 01/07/2012 8:08 pm