ActiveSheet.Range(\"b1\") = ActiveSheet.Name

[chemist]

J'ai 2 fois la même macro la seul différence c'Est qu'une permet de choisir le répertoire dans lequel ce trouve les fichiers et pour l'autre macro le répertoire est fixe. Quand j'utilise la fonction activesheet.name dans la macro ou le répertoire est déja déterminé ca fonctionne mais quand j'utilise l'autre macro qui permet de choisir le répertoire activesheet.name ne fonctionne plus. Ca fait des heures que je cherche l'erreur mais je trouve pas.

Donc voici la copie des 2 macros




Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib 'shell32.dll' _
Alias 'SHGetPathFromIDListA' (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib 'shell32.dll' _
Alias 'SHBrowseForFolderA' (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = 'Select a folder.'
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Range('a2') = GetDirectory
Else
GetDirectory = ''
End If
End Function


Sub Lecture_Resis()

Set fichcherche = Application.FileSearch
With fichcherche

.LookIn = GetDirectory
.Filename = '*.z'
If .Execute > 0 Then
MsgBox .FoundFiles.Count & 'Fichiers ont été trouvés'
Workbooks.Add
For I = 1 To .FoundFiles.Count
Workbooks.OpenText Filename:=.FoundFiles(I), Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Rows('1:3').Select
Selection.Delete Shift:=xlUp
Rows('3:136').Select
Selection.Delete Shift:=xlUp
Rows('4:4').Select
Selection.Delete Shift:=xlUp
Columns('B').Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range('b1') = ActiveSheet.Name
Range('A:C').Select
Selection.Copy
Windows('zview_macro.xls').Activate
Sheets('calcul').Activate
Range('A:C').Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
For Each Wk In Workbooks
If Wk.Name <> ThisWorkbook.Name Then
Wk.Close savechanges:=False
End If
Next Wk
With Worksheets('calcul')
Application.CutCopyMode = True
.Range('o65536').End(xlUp).Offset(1, 0).Value = .Range('a1').Value
.Range('o65536').End(xlUp).Offset(0, 1).Value = .Range('b1').Value
.Range('o65536').End(xlUp).Offset(0, 2).Value = .Range('a2').Value
.Range('o65536').End(xlUp).Offset(0, 3).Value = .Range('m37').Value
.Range('o65536').End(xlUp).Offset(0, 4).Value = .Range('n37').Value


End With
On Error Resume Next
Next I
Else
MsgBox 'Aucun fichier n'a ete trouve'
End If
End With
Sheets('résultats').Select
Columns('A:e').Select
Selection.Sort Key1:=Range('c1'), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheets('Macro').Select
Sheets('Macro').Activate
ActiveWindow.SelectedSheets.Visible = False
Sheets('résultats').Select
Range('f1').Select
sPath = Range('f1').Value
If Right(sPath, 1) <> '\\' Then sPath = sPath & '\\'
ActiveWorkbook.SaveAs sPath & ActiveSheet.Range('g1').Value

End Sub

2e macro

Sub Lecture_Resis()

Set fichcherche = Application.FileSearch
With fichcherche

.LookIn = 'C:\\macro'
.Filename = '*.z'
If .Execute > 0 Then
MsgBox .FoundFiles.Count & 'Fichiers ont été trouvés'
Workbooks.Add
For I = 1 To .FoundFiles.Count
Workbooks.OpenText Filename:=.FoundFiles(I), Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Rows('1:3').Select
Selection.Delete Shift:=xlUp
Rows('3:136').Select
Selection.Delete Shift:=xlUp
Rows('4:4').Select
Selection.Delete Shift:=xlUp
Columns('B').Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Range('b1') = ActiveSheet.Name
Range('A:C').Select
Selection.Copy
Windows('macrotest.xls').Activate
Sheets('calcul').Activate
Range('A:C').Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
For Each Wk In Workbooks
If Wk.Name <> ThisWorkbook.Name Then
Wk.Close savechanges:=False
End If
Next Wk
With Worksheets('calcul')
Application.CutCopyMode = True
.Range('o65536').End(xlUp).Offset(1, 0).Value = .Range('a1').Value
.Range('o65536').End(xlUp).Offset(0, 1).Value = .Range('b1').Value
.Range('o65536').End(xlUp).Offset(0, 2).Value = .Range('a2').Value
.Range('o65536').End(xlUp).Offset(0, 3).Value = .Range('m37').Value
.Range('o65536').End(xlUp).Offset(0, 4).Value = .Range('n37').Value

End With
On Error Resume Next
Next I
Else
MsgBox 'Aucun fichier n'a ete trouve'
End If
End With
Sheets('résultats').Select
Columns('A:e').Select
Selection.Sort Key1:=Range('c1'), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheets('Macro').Select
Sheets('Macro').Activate
ActiveWindow.SelectedSheets.Visible = False
Sheets('résultats').Select
Range('A1').Select
ActiveWorkbook.SaveAs Filename:= _
'C:\\macro\\Data.xls' _
, FileFormat:=xlNormal, Password:='', WriteResPassword:='', _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Message édité par: chemist, à: 02/08/2005 05:55

 

[fifi]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

bonjour B) il fait pas tres beau aujourd'hui
C'est un temps à passer sa journée sur Excel non?

 

[Franck02]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

Bonjour,
C'est vrai qu'il ne fait pas très beau. Y'en a même des fois qui sont tellement décu par la météo qu'ils oublient de dire 'bonjour', 's'il vous plait', 'merci', 'au revoir'. C'est quand même bizarre car il me semblait avoir vu une charte sur ce forum qui parlait de quelque chose comme ça... J'ai du me tromper.
@+ et bonne journée

 

[chemist]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

Bonjour, excuser mon impolitesse! C'est vrai qu'il manquait un bonjour merci a mon poste. Je ne sais pas si vous avez le même dicton chez vous (je suis du québec) mais faute avoué est à moitié pardonné.

Pour revenir a mon problème de macro est-ce qu'il y a quelqu'un qui aurait une idée, une piste à suivre.

Merci d'avance.

 

[chemist]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

Bonjour j'ai trouvé ( par hazar) mais si quelqu'un pouvait m'expliquer pourquoi.

quand je met ma macro dans un modul ça fonctionne mais quand je mais ma macro dans thisworkbook ca fonctionne pas.
toute la macro fonctionnait sauf
ActiveSheet.Range('b1') = ActiveSheet.Name

je suis débutant en VBA

c'est quoi la différence entre écrire la macro dans un modul et dans une feuille.

merci

 

[Bernard_XLD]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

Bonjour

pour les diverses fenêtres de code
1-module de feuille
module dédié aux procédures événementielles de la feuille, il se passe quelque chose sur la feuille, activation, changement de valeur, de sélection, etc
2-module thisworkbook
module dédié aux procédures événementielles du classeur, il se passe quelque chose sur le classeur.
3-userform
dédié aux interfaces(dialogues), permet de créer des fenêtres ou des boîtes de dialogue dans le projet
4-module
dédié aux procédures non événementielles, le plus courant. C'est la que l'enregistreur place ses macros.
5-module de classe
Module contenant la définition d'une classe, notamment les définitions de ses propriétés et de ses méthodes. Permet de définir des actions sur un type d'objet.

j'espére que c'est compréhensible

A+

 

[chemist]

Re:ActiveSheet.Range("b1") = ActiveSheet.Name

merci