organizar campos

hola Hector

(y que volver a leer y re-leer con detenimiento las propuestas, termina por rendir sus frutos)    ;)

no puedo estar mas de acuerdo, y aun mas en casos como el mio, que soy
lo que se llama por aqui un 'cagaprisas', y que en la 1ª lectura suelo
quedarme solo con lo mas 'grueso' ;-D

ya expondras tus resultados en cuanto te sea posible...

con un poco de verguenza aqui van esos resultados, aunque, aparte de
que seguramente seran bastante mejorables, no estan completos del
todo, pues falta, por un lado algo de lo mas importante:

=> el control de los saltos entre ventanas al pasar [hacia atras o
hacia delante] de los campos 'limite' de cada vista [lo tenia +/-
controlado, pero no acaba de ir del todo bien y prefiero reservarlo si
tengo tiempo]

=> y por otro lado controlar unos cuantos factores, como puede ser la
proteccion contra modificaciones del ancho de columnas mientre este
visible la organizacion, aparte de algunos mas que ahora mismo no veo
pero que seguro que existen

bueno, en cualquier caso creo que si da una idea de a lo que me
referia, aunque no se hasta que punto resultara practico ??, pero
[aparte de venirme bien para no perder del todo el contacto con 'mi'
excel], ya que esta, aqui va por si a alguien pudiera interesarle o
quiere/quereis comentar cualquier cosa (Ojo a los posibles saltos/
rotura de linea en el foro) =>

'***************************************************
' ORGANIZAR CAMPOS 11-06-2009
'
' Codigos para presentar en pantalla todos los
' campos de una tabla cuando estos excedan el
' ancho de la misma.
'
' OJO_1: en este ej. es imprescindible el uso de
' la funcion Split, pero si no me equivoco esta no
' esta disponible hasta la version 2000.
' En cualquier caso se puede prescindir de la funcion
' Split pej. almacenando los 'saltos' en una matriz
' en lugar de un string (y por supuesto modificando
' la forma de carga, pej. con Redim Preserve, y la
' de acceso a los saltos). O si se prefiere se puede
' implementar una version 'propia' de Split. Aqui
' copio una facilitada hace tiempo por Hector Miguel
' en el foro de excel de ms junto con las palabras
' de Hector:
'
' >> HM dixit =>
' ..
' [claro que] requiere ejecutarse a partir de excel
' 2000 [VBA6] por la funcion Split :-((
' si necesitas que sea operable desde la version xl97,
' deberas *proveer* tu propia funcion *Split*
' lo que puedes hacer con el siguiente codigo [p.e.]
' al final de tu modulo *normal*...
'
'#If Not VBA6 Then
'Function Split(Cadena As String, _
' Delimitador As String) As Variant
' Split = Evaluate("{""" & Application.Substitute( _
' Cadena, Delimitador, """,""") & """}")
'End Function
'#End If
'
'
'
' OJO_2: el codigo esta escrito a ratos y de momento
' sin intentar optimizarlo, por lo que seguro que
' contiene garn cantidad de redundancias y es muy
' mejorable, aparte de no tener control de errores,
' pero al menos parece funcionar, aunque habria que
' tener en cuenta bastantes factores que pueden
' dar algunos problemas, como por ej. si el numero
' de campos es muy grande o estos son tan anchos
' que impidan la visibilidad de los datos.
' Tambien elimina las posibles secciones y los
' rangos inmovilizados, si los hay, en el original.
' La tabla debe comenzar en la columna A y tener los
' titulos de campo en la fila 1.
'*****************************************************
'
' En un modulo normal =>
'
' Para activar y/o desactivar la 'organizacion'
Public verTodos As Boolean
' Para concatenar las columnas en que se
' produciran los 'saltos' de campo separados
' por un espacio y recuperarlos mediante Split
Public saltos As String
' Para concatenar los anchos originales de las
' columnas y reponerlos mediante Split
Public anchosCol As String
' Titulo de la ventana original
Public ventana As String

' Devuelve una cadena con los anchos de las columnas
' del rango pasado separados por espacios.
Function anchos(ByVal pRng As Range) As String
Dim w As String
Dim n As Integer
w = ""
With pRng
For n = 1 To .Columns.Count
w = w & " " & .Cells(1, n).ColumnWidth
Next
End With
anchos = Trim(w)
End Function

' Ajusta el ancho de las columnas de un rango para que
' ocupen el maximo del valor de pmax (que en este caso
' seria el ancho 'usable' de la pantalla. Se utilizan
' varios valores aleatorios (0,75 y 22) obtenidos a
' base de pruebas, pero puede que no sean los idoneos en
' todos los casos (pej. no se si deberian variarse segun
' la resolucion de la pantalla).
Sub ajustarAnchos(ByRef pRng As Range, ByVal pMax As Double)
Dim c As Integer
With pRng
Do While .Width < (pMax - 22)
For c = 1 To .Columns.Count
.Cells(1, c).ColumnWidth = _
.Cells(1, c).ColumnWidth + 0.75
If .Width >= (pMax - 22) Then Exit For
Next
Loop
End With
End Sub

' Ajusta el ancho de las columnas del rango pasado a los
' valores pasados en pAnchos, que debera ser una cadena
' formada por los anchos separados por un espacio.
Sub reponerAnchos(ByRef pRng As Range, ByVal pAnchos As String)
Dim n As Integer
For n = LBound(Split(pAnchos)) To UBound(Split(pAnchos))
pRng.Cells(1, n + 1).ColumnWidth = Val(Split(pAnchos)(n))
Next
End Sub

' Elimina posibles secciones y rangos inmovilizados de
' la ventana pasada en pWdw.
Sub quitarDivisiones(ByRef pWdw As Window)
With pWdw
If .FreezePanes = True Then .FreezePanes = False
.Split = False
End With
End Sub

' Fija la 1ª fila con los titulos de campo.
Sub fijarTitulos(ByRef pWdw As Window)
With pWdw
.SplitRow = 1
.FreezePanes = True
End With
End Sub

' Crea las ventanas necesarias para ver todos los
' campos en una misma pantalla y las organiza en
' mosaico horizontal. Me da la impresion de que
' es bastante simplificable.
Sub organizarCampos(ByRef pHj As Worksheet)
pHj.Activate
Dim rng As Range
Set rng = ActiveCell
pHj.Cells(1).Select
Dim colsRango As Integer
Dim colsV As Integer
Dim sumaCols As Integer
Dim nv As Integer
Dim w As Integer
colsRango = pHj.Cells(1).CurrentRegion.Columns.Count
With ActiveWindow
colsV = .VisibleRange.Columns.Count
If colsV > colsRango Then Exit Sub
ventana = .Caption
End With
anchosCol = anchos(pHj.Cells(1).CurrentRegion)
Application.ScreenUpdating = False
quitarDivisiones ActiveWindow
fijarTitulos ActiveWindow
sumaCols = colsV - 1
nv = 1
saltos = colsV - 1
w = 0
Do While pHj.Cells(1, sumaCols + 1) <> ""
If w = 0 And rng.Column <= sumaCols Then _
w = ActiveWindow.WindowNumber
ActiveWindow.NewWindow
nv = nv + 1
ActiveWindow.ScrollColumn = sumaCols + 1
fijarTitulos ActiveWindow
colsV = ActiveWindow.VisibleRange.Columns.Count
saltos = Trim(saltos & " " & (colsV - 1))
ajustarAnchos ActiveWindow.VisibleRange _
.Resize(1, colsV - 1), ActiveWindow.UsableWidth
If nv > 2 Then ActiveWindow.ActivateNext
sumaCols = sumaCols + colsV - 1
Loop
Windows(ventana & ":1").Activate
ajustarAnchos ActiveWindow.VisibleRange _
.Resize(1, colsV - 1), ActiveWindow.UsableWidth
Windows.Arrange ArrangeStyle:=xlHorizontal
Windows(ventana & ":" & w).Activate
rng.Select
Set rng = Nothing
Application.ScreenUpdating = True
End Sub

' Elimina las ventanas creadas y deja la ventana original.
Public Sub normalizarCampos(ByRef pHj As Worksheet)
If saltos = "" Then Exit Sub
Dim rng As Range
Set rng = ActiveCell
Dim n As Integer
Application.ScreenUpdating = False
For n = UBound(Split(saltos)) + 1 To 2 Step -1
Windows(ventana & ":" & n).Close
Next
saltos = ""
ActiveWindow.WindowState = xlMaximized
reponerAnchos pHj.Cells(1).CurrentRegion, anchosCol
anchosCol = ""
Application.ScreenUpdating = True
rng.Select
Set rng = Nothing
ventana = ""
End Sub

' Hace de interruptor para mostrar/quitar la organizacion
' de los campos de la hoja pasada como parametro.
' No me gusta demasiado este formato de 'interruptor'
' (boolean = Not boolean), pero para las prisas hace
' el apaño, y es facilmente modificable.
Public Sub determinarVista(ByRef pHj As Worksheet)
verTodos = Not verTodos
If verTodos Then
organizarCampos pHj
Else
normalizarCampos pHj
End If
End Sub

' Para hacer las pruebas (para tabla en la 1ª hoja).
' Podria ser directamente el click de un boton o similar.
Sub Test()
determinarVista Worksheets(1)
End Sub

' ..
' En el modulo de la hoja

' Sincroniza la fila activa entre ventanas al cambiar
' la seleccion, pero falta sincronizar el salto entre
' ventanas al cambiar de campo.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If saltos = "" Then Exit Sub
Dim n As Integer
For n = LBound(Split(saltos)) To UBound(Split(saltos))
Windows(ventana & ":" & (n + 1)).ScrollRow = Target.Row
Next
End Sub


disculpas por el tomo

un saludo
Ivan