Notifications
Clear all

Help com macro para travar barra de rolagem

4 Posts
1 Usuários
0 Reactions
2,098 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Pessoal,

A macro abaixo teoricamente deveria travar as barras de rolagem de doas as abas de minha planilha, contudo não consigo fazer funcionar, alguém pode ajudar?

Abraços,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Sh.Cells) > 0 Then

'Search for any entry, by searching backwards by Rows.
LastRow = Sh.Cells.Find(What:="*", After:=Sh.Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If LastRow <> 65536 Then LastRow = LastRow + 1

'Search for any entry, by searching backwards by Columns.
LastColumn = Sh.Cells.Find(What:="*", After:=Sh.Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

If LastColumn <> 256 Then LastColumn = LastColumn + 1

Sh.ScrollArea = Range(Cells(1, 1), Cells(LastRow, LastColumn)).Adress

Else
Sh.ScrollArea = ""

End If

End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 24/02/2011 8:44 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa noite Guilherme

Tentando ajudar, posto esta Macro que encontrei na Net.
Ela oculta as barras de rolagem:

Ocultar as barras

Sub SemBarras()
 Dim bArras
 Application.DisplayFullScreen = True
 Application.DisplayFormulaBar = False
 ActiveWindow.DisplayHeadings = False
 ActiveWindow.DisplayHorizontalScrollBar = False
 ActiveWindow.DisplayVerticalScrollBar = False
 ActiveWindow.DisplayWorkbookTabs = False
 For Each bArras In Application.CommandBars
   bArras.Enabled = False
 Next
End Sub

Normalizar as barras

Sub ComBarras()
Dim bArras
 Application.DisplayFullScreen = False
 Application.DisplayFormulaBar = True
 ActiveWindow.DisplayHeadings = True
 ActiveWindow.DisplayHorizontalScrollBar = True
 ActiveWindow.DisplayVerticalScrollBar = True
 ActiveWindow.DisplayWorkbookTabs = True
 For Each bArras In Application.CommandBars
  bArras.Enabled = True
 Next
End Sub

Vc tem que criar botões e associar a estas Macros.

OBS.:Antes de fechar a planilha vc tem que Normalizar as Barras clicando no botão.
Eu não testei esta macro.

Um abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 24/02/2011 5:14 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Guilherme, se entendi corretamente, você quer definir o ""ScrollArea" na Área com Dados, se for isto teste a rotina abaixo:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim LastColumn As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Sh.Cells) > 0 Then

    'Search for any entry, by searching backwards by Columns.
    LastColumn = Sh.Cells.Find(What:="*", After:=Sh.Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    'Última Celula preenchida
    Set LastCell = Cells(16384, LastColumn).End(xlUp)

    If LastColumn <> 256 Then
        
        Sh.ScrollArea = Cells(1, 1).Address & ":" & LastCell.Address
   
    Else
        Sh.ScrollArea = ""
    
    End If
End If
End Sub

As rotinas que o Patropi passou são interessantes, apresentam a planilha em fullScreen desabilitando todas as barras de ferramentas, de rolagem, guias das planilhas, entre outras, mas não impede que naveguemos pelas Colunas e Linhas.
Se quiser podemos adaptar a rotina do ScrollArea juntamete com as que ele passou.

abraços

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 24/02/2011 8:49 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Mauro,

Obrigado seu cod funcionou, valeu...

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/02/2011 7:16 am