Pb avec une macro

[Huggy]

Bonjour,
J'ai récupéré une macro sur papier et je l'ai recopié sur visual.
Cette macro doit me permettre de visualiser les formats des cellules.
Problème : il y a un bug mais je ne sais pas réparer . J'ai relu mais rien à faire
Ci-joint la macro.
Merci d'avance,

Sub format_cellule()
'
' format_cellule Macro
' Macro enregistrée le 28/03/2005 _ recherche les formats des cellules

'
Function GetFormat(cell)
GetFormat = cell.NumberFormat
End Function

Sub afficheFormats()
Dim nomFeuille, lastCol, lastRow
'lastRow : numéro de la dernière ligne utilisée
lastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
'lastcol : numéro de la dernière colonne utilisée
lastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
nomFeuille = ActiveSheet.Name

ActiveWorkbook.Sheets.Add after:=ActiveSheet
ActiveSheet.Name = nomFeuille & '-Formats'
Range('A1').Formula = '=getFormat(' & nomFeuille & '!A1)'
'Etendre cette formule à toutes les lignes et colonnes utilisées
Range('A1').AutoFill Destination:=Range('A1:A' & lastRow), Type:=xlFillDefault
Range('A1:A' & lastRow).AutoFill Destination:=Range(Cells(1, 1), Cells(lastRow, lastColl)), Type:=xlFillDefault
Application.CalculateFull
End Sub
'
End Sub

 

[pat1545.]

Salut,

ceci doit aller :


Function GetFormat(cell)
GetFormat = cell.NumberFormat
End Function

Sub afficheFormats()
Dim nomFeuille, lastCol, lastRow
'lastRow : numéro de la dernière ligne utilisée
lastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
'lastcol : numéro de la dernière colonne utilisée
lastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
nomFeuille = ActiveSheet.Name

ActiveWorkbook.Sheets.Add after:=ActiveSheet
'ActiveSheet.Name = nomFeuille & '-Formats'
Range('A1').Formula = '=getFormat(' & nomFeuille & '!A1)'
'Etendre cette formule à toutes les lignes et colonnes utilisées
Range('A1').AutoFill Destination:=Range('A1:A' & lastRow), Type:=xlFillDefault
Application.CalculateFull
End Sub

Patrick

 

[Huggy]

Bonsoir Patrick,

Tout d'abord merci pour ta réponse.
J'ai essayé mais cela ne fonctionne pas. Si j'ai bien analysé le problème, l'analyse du format se passe bien sur la première cellule (A1), mais aprés j'obtiens ques des #valeur sur la colonne A jusqu'à la derniére ligne utilisée, mais l'analyse semble ne pas pouvoir être faite sur les colonnes suivantes autrement dit le passage de la première colonne aux autres semble ne pouvoir se faire.

Merci

 

[_Thierry]

Bonsoir Huggy, Pat1545, le Forum

Heuh, c'est le genre de truc qui génére erreurs sur erreurs ta question, et y en a qui vont dire encore que j'abuse du Goto !!! (Goto the Next Whisky Bar, Jim Morrisson, of course !!!)

Option Explicit

Function GetFormat(ByVal Cell As Range)
GetFormat = Cell.NumberFormat
End Function

Sub AfficheFormats()
Dim NomFeuille As String
Dim LastCol As Integer
Dim LastRow As Long
Dim RBase As Range, RFirstRow As Range, RFirstCol As Range
Dim RWholePlage As Range


    With ActiveSheet
        LastRow = .Range('A65536').End(xlUp).Row
        LastCol = .Range('IV1').End(xlToLeft).Column
        NomFeuille = .Name
    End With

ActiveWorkbook.Sheets.Add after:=ActiveSheet
   
    With Application
    .DisplayAlerts = False
        On Error Resume Next
        Sheets(NomFeuille & '-Formats').Delete
        ActiveSheet.Name = NomFeuille & '-Formats'
        On Error GoTo 0
    .DisplayAlerts = True
    End With

Set RBase = Range('A1')
Set RFirstRow = Range(Cells(1, 1), Cells(1, LastCol))
Set RFirstCol = Range(Cells(1, 1), Cells(LastRow, LastCol))
Set RWholePlage = Range(Cells(1, 1), Cells(LastRow, LastCol))
RBase.Formula = '=GetFormat(' & NomFeuille & '!A1)'

    On Error GoTo Out1
        RBase.AutoFill Destination:=RFirstRow, Type:=xlFillDefault
        On Error GoTo Out2
            RFirstRow.AutoFill Destination:=RWholePlage, Type:=xlFillDefault
            Application.CalculateFull
                Exit Sub

Out1:
    On Error GoTo 0
        On Error GoTo DefinitlyOut 'LOL !!
        RBase.AutoFill Destination:=RFirstCol, Type:=xlFillDefault
        MsgBox 'la feuille ne contenait qu'une seule colonne de données'
        Application.CalculateFull
Exit Sub
Out2:
    RBase.AutoFill Destination:=RFirstRow, Type:=xlFillDefault
    MsgBox 'la feuille ne contenait qu'une seule ligne de données'
    Application.CalculateFull
Exit Sub
DefinitlyOut:
MsgBox 'la feuille ne contenait qu'une seule cellule de données'
End Sub

Voilà ce devrait pouvoir un peu mieux fonctionner mais bon j'ai fait ça vite fait sans tout tester, mais y a déjà du boulot !

Bonne Soirée
@+Thierry

Message édité par: _Thierry, à: 28/03/2005 22:47

 

[_Thierry]

héhéhé José !!!



Moi je l'ai pas raté pour ton anniversaire le Pack de Duvel !!!

Mais le Bonnes Pâques..... de Bières, alors celle là on me l'avait jamais faite !!! Mort de Rire !!!

Sorry Huggy, pour le léger dérappage sur ton Fil !!! lol

Bonne Soirée@+Thierry

PS au fait prends RV chez l'ophtalmo, José, sont toujours pas transparent les Smileys !!! sauf le mien

 

[_Thierry]

Bonjour José, le Fil, le Forum

Voilà comme je vois ton post (IE 6.0 en 1280 x 1024 32 bits)



Je file, zappé le réveil avec ce changment d'heure !!! lol
Bonne Journée

@+Thierry

 

[Brigitte]

Bonjour à tous,


Ben moi non plus, l'autre jour, JOSE pas le dire, mais les smileys étaient toujours pas transparents pour le fond.

Et là ca continue, je le confirme.

Je vous souhaite NEZ EN MOINS une bonne journée.