re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$DHA.684@tk2msftngp13.phx.gbl...
Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
Quand je disais que j'étais bizarre.
Cela fonctionne correctement.
Milles merçi
"Jacky" a écrit dans le message de
news:uLsf4eg$re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
messagenews: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté
Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de
dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1),
_
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending,
Header:=xlGuess,
_OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
Quand je disais que j'étais bizarre.
Cela fonctionne correctement.
Milles merçi
"Jacky" <Jackyenlevez.jaeg@wanadoo.fr> a écrit dans le message de
news:uLsf4eg$DHA.3536@tk2msftngp13.phx.gbl...
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$DHA.684@tk2msftngp13.phx.gbl...
Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté
Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de
dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1),
_
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending,
Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
Quand je disais que j'étais bizarre.
Cela fonctionne correctement.
Milles merçi
"Jacky" a écrit dans le message de
news:uLsf4eg$re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
messagenews: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté
Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de
dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1),
_
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending,
Header:=xlGuess,
_OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$DHA.684@tk2msftngp13.phx.gbl...
Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
re...
Chez moi cela fonctionne sans problème.......
Bizarre bizarre quand tu nous tiens
JJ
"David T." <direction-ternoise@(enlever)wanadoo.fr> a écrit dans le
message
news: u1sICRg$Encore merci à tous
J'essai de comprendre le VB, cela démarre mal !!!
Je mets les 2 modules ci-dessous.
Je précise quils sont dans le même projet mais dans 2 modules
différents.
J'aimerais qu'à la fin de la macro Sub Selection_Mois() soit exécuté Sub
Liste_Sans_Doublons()
1er Module :
Sub Selection_Mois()
' Permet l'affichage d'une boîte de dialogue avec les noms
' des onglets puis selectionne ce nom et l'inscrire dans une cellule
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet, FeuilleDépart As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
' Ajoute une feuille de dialogue temporaire
Set CurrentSheet = ActiveSheet
Set FeuilleDépart = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = 0
' Ajoute les boutons d'option
TopPos = 40
For i = 4 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Ne tient pas compte des feuilles vide ou masquées
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(SheetCount).Text = _
CurrentSheet.Name
If CurrentSheet.Name = FeuilleDépart.Name Then _
PrintDlg.OptionButtons(SheetCount).Value = xlOn
TopPos = TopPos + 13
End If
Next i
' Positionne les boutons OK et Annuler
PrintDlg.Buttons.Left = 240
' Dimensionne la hauteur, la largeur et le titre de la bte de dialogue
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 250
.Caption = "Sélectionez un mois "
End With
' Change l'ordre de tabulation des boutons OK et Annuler
' afin de donner le focus au premier bouton d'option
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Affiche la boîte de dialogue
FeuilleDépart.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
Application.ScreenUpdating = False
For i = 1 To SheetCount
If PrintDlg.OptionButtons(i).Value = xlOn Then
'Pour inscrire dans la cellule O3 l'option récupérée
[O3] = PrintDlg.OptionButtons(i).Caption
End If
Next i
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If
' Supprime la feuille de dialogue temporaire (sans message
d'avertissement)
Application.DisplayAlerts = False
PrintDlg.Delete
'Liste_Sans_Doublons 'Içi le problème
End Sub
2ème Module :
Sub Liste_Sans_Doublons()
'Permet de lister et trier par ordre alhabétique
Dim CollObject As New Collection
Dim Counter As Long
Dim FirstDataRow As Long
Dim LastRow As Long
Dim NameOfSheet As String
Dim SearchColumn As String
Dim SearchRange As Range
Dim SearchData As Variant
Dim UniqueColumn As Long
Dim UniqueData() As Variant
'paramètres de travail :
With ActiveSheet
Range("B6:B75").Select
Selection.ClearContents
Range("B6").Select
NameOfSheet = [O3]
End With
SearchColumn = "C"
FirstDataRow = 4 ' s'il y a une ligne d'entête
On Error Resume Next
With Worksheets(NameOfSheet)
UniqueColumn = .Columns(SearchColumn).Column
LastRow = .Cells(65536, UniqueColumn).End(xlUp).Row
Set SearchRange = .Range(.Cells(FirstDataRow, UniqueColumn), _
.Cells(LastRow, UniqueColumn))
SearchData = SearchRange.Value
For Counter = FirstDataRow To LastRow
CollObject.Add Item:=SearchData(Counter - FirstDataRow + 1, 1), _
key:=CStr(SearchData(Counter - FirstDataRow + 1, 1))
Next Counter
End With
ReDim UniqueData(1 To CollObject.Count, 1 To 1)
For Counter = 1 To CollObject.Count
UniqueData(Counter, 1) = CollObject(Counter)
Next Counter
'pour renvoyer le résultat dans une feuille de calcul
Sheets("Relevé Général").Select
Range("B6").Resize(UBound(UniqueData, 1), 1).Value = UniqueData
Range("B6:B75").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Range("O3").Select
End Sub
