Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

VBA et TEXTBOX

J

JC de Lorient

Guest
Bonjour le 'nouveau' forum !

suis tjrs en peine avec VBA !!

voilà ce que je souhaiterais obtenir

a partir d'un CommandButton7 qui va allez chercher une feuille bien précise qu'on pose la question ' quelle année? ' ex 2005
si la feuille existe l'ouvrir et se mettre en A1 sinon un message ' cette feuille n'existe pas créez là '

merci beaucoup

JC
 
H

Hervé

Guest
Bonjour

une proposition :

Code:
Private Sub CommandButton1_Click()
Dim feuilles As String
Dim ws As Object

feuilles = InputBox('Quelle feuille voulez-vous activer ?')
If feuilles = '' Then Exit Sub
For Each ws In Worksheets
    If ws.Name = feuilles Then
        Sheets(ws.Name).Activate
        Exit Sub
    End If
Next ws

MsgBox 'Cette feuille n'existe pas.'
End Sub

Ma première réponse, sur le nouveau xld, je suis ému.

Salut
Hervé
 
H

Hervé

Guest
Re

Et ma première 'zoperie', lol

J'avais pas vu le mot textbox dans le nom du message :

remplace : feuilles = InputBox('Quelle feuille voulez-vous activer ?')

par : feuilles=textbox1

Salut
Hervé
 
J

JC de Lorient

Guest
re tout le monde

j'ai ce code :

Private Sub CommandButton2_Click()
Dim TheYear As String
TheYear = Format(Date, 'YYYY')

Worksheets(TheYear).Activate
End Sub

je souhaiterais rajouter un message d'erreur et ne pas lancer le débogage si la feuille n'existe pas

merci à vous

JC
 
T

Temjeh

Guest
Salut Jc et bonjour à tous

Aussi:

sous un bouton:

Sub NouvelleFeuille()
Dim Nom_Fichier
Debut:
Nom_Fichier = Application.InputBox(prompt:='*Quelle année?*')
If Nom_Fichier = 'Faux' Then Exit Sub
If Nom_Fichier = '' Then
MsgBox 'Entrer un nom'
GoTo Debut
Else
For Each ws In Worksheets
If ws.Name = Nom_Fichier Then
Sheets(Nom_Fichier).Select
Range('A1').Select
GoTo Debut
End If
Next
Sheets('Model').Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Nom_Fichier
Range('A1').Select
End If
End Sub
 
H

hervé

Guest
re

une proposition par un gestionnaire d'erreur, attention ce code va te gérer toutes les erreurs possibles dans la macro, pas seulement l'erreur 9

Code:
Private Sub CommandButton2_Click()
Dim TheYear As String

On Error GoTo Message
TheYear = Format(Date, 'YYYY')

Worksheets(TheYear).Activate

Exit Sub

Message:
MsgBox 'Cette feuille n'existe pas'

End Sub

salut
Hervé
 
J

JC de Lorient

Guest
Merci Hervé, Tomjeh, le forum

Tom suis désolé j'ai un bug avec ton code !!
celui d'Hervé fonctionne bien mais je viens de me rendre compte que j'ai pas bien formulé ma question dans le sens ou je ne suis pas sur une année civile mais année qui débute en mars jusque Février

en clair ma saison 2005 commence en 03/2005 et fini fin février 2006

est ce que le code que vous m'avez donné est adaptable a ce critère ?

si oui mille merci et sinon 'dommage' !!! lol

merci a vous

JC
 
T

Temjeh

Guest
L'erreur viens surement du fait que tu doit adapter une ligne...celle du classeur model.

Pour que ca ne bogue pas tu doit y faire une feuil et la nommé Model et il te copie cette feuil ou change la ligne Sheets('Model').Copy After:=Sheets(Sheets.Count)
pour Sheets.Add


Cette macro voit tout simplement si ta feuil existe si oui elle la sélectionne en A1 sinon elle fait une copie de Model et la nomme du nom que tu cherchais

A++

Temjeh
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Re

Temjeh tu dois avoir une erreur sur une ligne

je pense que tu as un Goto Debut à la place d'un exit sub

Sub NouvelleFeuille()
Dim Nom_Fichier
Debut:
Nom_Fichier = Application.InputBox(prompt:='*Quelle année?*')
If Nom_Fichier = 'Faux' Then Exit Sub
If Nom_Fichier = '' Then
MsgBox 'Entrer un nom'
GoTo Debut
Else
For Each ws In Worksheets
If ws.Name = Nom_Fichier Then
Sheets(Nom_Fichier).Select
Range('A1').Select
GoTo Debut ' ICI à mon avis c'est Exit Sub
End If
Next
Sheets('Model').Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Nom_Fichier
Range('A1').Select
End If
End Sub

Message édité par: Pascal76, à: 21/02/2005 13:37
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…