Code VBA à modifier

[archi]

Bonjour,

j'aimerai, dans le code ci joint, que le nom de mon onglet se transforme en minuscule ('Dupont'), possible ou pas ??

(PS: je saisie toujours dans la Inputbox le nom et le prénom comme suis 'DUPONT Jean')
merci d'avance


Sub Bouton1()
Dim nom As String
Dim mafeuille As String

mafeuille = InputBox('Nom de feuille ?')
nom = Mid(mafeuille, 1, InStr(1, mafeuille, ' ') - 1)

If mafeuille <> '' Then
Worksheets('Exemple').Copy After:=Worksheets('Exemple')
With ActiveSheet
.Name = nom
.Range('a1') = mafeuille
End With
End If


End Sub

Message édité par: archi, à: 08/08/2005 18:34

 

[Eric C]

Bonjour le forum
Bonjour archi

Essaies avec ceci :

Sub CommandButton1_Click()
Dim nom As String, Maj As String, Reste As Byte, Min As String
Dim mafeuille As String

mafeuille = InputBox('Nom de feuille ?')
nom = Mid(mafeuille, 1, InStr(1, mafeuille, ' ') - 1)

If mafeuille <> '' Then
Worksheets('Exemple').Copy After:=Worksheets('Exemple')

Maj = UCase(Left(nom, 1))
Reste = Len(nom) - 1
Min = LCase(Right(nom, Reste))Range('A1') = Maj & Min

With ActiveSheet
.Name = Maj & Min 'nom
.Range('a1') = mafeuille
End With
End If
End Sub

Bonne soirée à toutes & à tous 😉

 

[archi]

merci,

hélas il y a un bug dans ton code au niveau de ligne
Min = LCase(Right(nom, Reste))Range('A1') = Maj & Min

 

[myDearFriend!]

Bonjour archi, Eric C, le forum.

En complément de la solution d'Eric C (que je salue au passage), ci-dessous, une autre façon de faire :

Sub Bouton1()
Dim nom As String, mafeuille As String

      mafeuille =InputBox('Nom de feuille ?')
      If Trim(mafeuille) = '' Then Exit Sub
      If InStr(1, mafeuille, ' ') < 1 Then Exit Sub
      nom = Mid(mafeuille, 1, InStr(1, mafeuille, ' ') - 1)
      Worksheets('Exemple').Copy After:=Worksheets('Exemple')
      With ActiveSheet
            .Name = Application.WorksheetFunction.Proper(nom)
            .Range('a1') = mafeuille
      End With
End Sub

Cordialement

 

[archi]

Excellent myDearFriend!

bye

 

[Eric C]

Re le forum
Re bonjour archi, bonjour Didier

Content de te croiser Didier (j'ai lu que tu n'avais plus trop le temps de passer)

Chez moi (XL 2000) le code ne pose pas problème ?

Enfin le principal est qu'archi est été dépanné. 😉

 

[archi]

je prends encore de votre temps pour me corriger un autre code

voilà, le code qui suit, me ventile des données dans des feuilles de joueurs (les même que le code vu plus haut)
néanmoins, j'ai un problème quand mais feuilles on le même nom(normal)
j'ai donc renommer certaines feuilles comme suit ('Dupont J' ou 'Dupont G')
cependant je n'arrive pas à modifier le code en ligne
With Sheets(Nom)

PS: en C2 j'ai un menu déroulant avec des noms sous la forme ('DUPONT Jean')
merci de votre aide

------------------------------
Sub macro()
Application.ScreenUpdating = False
With Sheets('Saisie individuel')
Nom = Left(.Range('C2'), Application.Find(' ', .Range('C2'), 1) - 1)
End With
With Sheets(Nom)
Lig1 = .Range('A10000').End(xlUp).Row
Range(.Range('H' & Lig1 + 1), .Range('H' & Lig1 + 3)).Clear
End With
With Sheets('Saisie individuel')
Lig = .Range('B5').End(xlDown).Row
.Range('B5:J' & Lig).Copy
End With
With Sheets(Nom)
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
.Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Range(.Range('A4'), .Range('H' & Lig1)).Validation.Delete
Lig1 = .Range('A65536').End(xlUp).Row
Lig2 = .Range('J65536').End(xlUp).Row + 1
.Range('A4:H' & Lig1).Validation.Delete
Range(.Range('A4'), .Range('H' & Lig1)).Sort Key1:=.Range('A4'), Order1:=xlAscending
Range(.Range('J' & Lig2 - 1), .Range('M' & Lig2 - 1)).AutoFill _
Destination:=Range(.Range('J' & Lig2 - 1), .Range('M' & Lig1)), Type:=xlFillDefault
End With
Sheets('Saisie individuel').Activate: Range('C2').Select
Application.ScreenUpdating = True
End Sub

 

[myDearFriend!]

Bonsoir archi, Eric C, le Forum.

Heu... pas sûr d'avoir tout compris de ta question archi, mais à tout hasard :

Dim Nom As String
      ...
      With Sheets('Saisie individuelle').Range('C2')
            If InStr(1, .Value, ' ') < 1 Then Exit Sub
            Nom = Left(.Value, InStr(1, .Value, ' ') + 1)
      End With

Cordialement,

PS :
je pense que le code d'Eric C devait fonctionner archi, toutefois il ne fallait pas lire :

Min = LCase(Right(nom, Reste))Range('A1') = Maj & Min

mais certainement,

Min = LCase(Right(nom, Reste))
Range('A1') = Maj & Min

 

[archi]

Merci myDearFriend!, mais ça ne fonctionne pas
je te joint mon fichier pour une meilleur compréhension
bye

[file name=Test_BDV6_20050810085751.zip size=38040]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Test_BDV6_20050810085751.zip[/file]

 

[myDearFriend!]

Bonsoir archi, le Forum.

Bon, comme le nom de tes onglets ne possèdent pas la même casse que les noms présents dans ta liste,
dans ta 'Sub macro()' par exemple, il convient de remplacer :

With Sheets('Saisie individuel')
Nom = Left(.Range('C2'), Application.Find(' ', .Range('C2'), 1) - 1)
End With

Par (exactement) :

With Sheets('Saisie individuel').Range('C2')
      If InStr(1, .Value, ' ') < 1 Then Exit Sub
      Nom = Left(.Value, InStr(1, .Value, ' ') + 1)
      Nom = Application.WorksheetFunction.Proper(Nom)
End With

Je te laisse adapter la même chose dans les autres procédures...

Cordialement,

 

[archi]

Merci tu as résolu le prob avec les noms identiques
cependant le problème reste entier concernant la feuille 'Zieger' ??

question:
peut on associer les deux format de Noms d'onglet, à savoir 'Neef O' et 'Zieger' ?
si oui, peux tu corriger le code ?
si non, je prend le format 'Neef O'
dans ce cas, peux tu adapter le code suivant, pour avoir un format d'onglet du type 'Neef O'

merci d'avance
bye
--------------------------------
Sub Bouton1()
Dim nom As String, mafeuille As String

mafeuille =InputBox('Nom de feuille ?')
If Trim(mafeuille) = '' Then Exit Sub
If InStr(1, mafeuille, ' ') < 1 Then Exit Sub
nom = Mid(mafeuille, 1, InStr(1, mafeuille, ' ') - 1)
Worksheets('Exemple').Copy After:=Worksheets('Exemple')
With ActiveSheet
.Name = Application.WorksheetFunction.Proper(nom)
.Range('a1') = mafeuille
End With
End Sub

Message édité par: archi, à: 11/08/2005 18:56

 

[myDearFriend!]

Bonjour archi, le forum,

peut on associer les deux format de Noms d'onglet, à savoir 'Neef O' et 'Zieger' ?
si oui, peux tu corriger le code ?

On peut tout faire (ou presque) avec Excel..., mais à ce rythme là, je sens pointer l'usine à gaz ! Certains avec l'initiale du prénom et d'autres sans, on se demande déjà pourquoi ? Par ailleurs, comment feras-tu quand tu tombera sur un homonyme ?

si non, je prend le format 'Neef O'
dans ce cas, peux tu adapter le code suivant, pour avoir un format d'onglet du type 'Neef O'

Là, c'était quand même pas trop difficile...il suffit simplement d'inverser un opérateur ! (as-tu essayé de comprendre le code qui t'a été proposé ? Un simple tour dans l'aide VBA sur la fonction 'Mid()' et tu aurais su le faire je pense...) :

Sub Bouton1()
Dim nom As String, mafeuille As String

      mafeuille = InputBox('Nom de feuille ?')
      If Trim(mafeuille) = '' Then Exit Sub
      If InStr(1, mafeuille, ' ') < 1 Then Exit Sub
      nom = Mid(mafeuille, 1, InStr(1, mafeuille, ' ') + 1)
      Worksheets('Exemple').Copy After:=Worksheets('Exemple')
      With ActiveSheet
            .Name = Application.WorksheetFunction.Proper(nom)
            .Range('a1') = mafeuille
      End With
End Sub

Cordialement,

 

[archi]

merci, mais je débute dans le VBA

Message édité par: archi, à: 13/08/2005 11:39

 

[_Thierry]

Bonsoir Archi, Didier, Eric, le Fil le Forum

Rapidos avant de partir ... Voici comment tester si une Formule ne retourne rien ...

Sub TestIfValue()
With ActiveCell
&nbsp; &nbsp; If .HasFormula = True Then
&nbsp; &nbsp; &nbsp; &nbsp; If .Value = '' Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; MsgBox 'La Cellule contient une formule mais n'a aucun résultat'
&nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; End If
End With
End Sub

Bonne Soirée
[ol]@+Thierry[/ol]

 

[archi]

Merci Thierry

autre question, autre problème de macro:

pour plus de détailles et de simplicité, je vous joint mon fichier

merci d'avance
bye

[file name=Test_BDV7.zip size=41585]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Test_BDV7.zip[/file]