modifier la taille d'une ligne en VBA

[Thomas]

Bonjour le forum,

j'ai créer un USF qui me permet de saisir sur différente feuille des infos prédéfinie puis j'ai un textebox ou je saisie manuellement des info, cepandant, il arrive que mes saisie soit important et dans ce cas je dois retouner sur le ta pour agrandire la ligne en question.

cependant le but de ce USF est de cacher les feuilles car je ne fait que de la saisie et de la consultation avec le USF en sachant que je selectionne ma feuille pour l'imprimé (et c'est là ou c'est génant).

moi je pense plus à un code ou je lui dirais si dans textbox1 j'ai moins de 30 caractere alors rien sinon si plus de 30 mais mois de 60 alors taille de ligne = n sinon si sup de 60 et inférieur de 90 alors taille de ligen = n' ......

d'avance merci.

sinon sur mon fichier j'ai un autre probléme de variable non libéré ce qui fait que si je fait uniquement de la consultation le contenu de mes combobox double triple .....

Merci d'avance

 

[PascalXLD]

Bonjour

Pour la première partie de ta question tu peus peut-être jouer avec hauteur de ligne automatique

.EntireRow.AutoFit

Pour la deuxième partie regardes où tu alimentes tes combobox peut-être est-ce sur un evenement qui revient souvent et par moment il faut d'abord faire un combobox.clear avant de le remplir

Bon courage

 

[Thomas]

Merci pour ta reponse mais je l'écrit où cette fonction '.EntireRow.AutoFit'

sinon pour la deusieme partie voici mon code (pour moi ce la vient de VarMois):

Dim LabelClasses(100 To 101) As LabelClasse
Dim DerligneDonnées As Integer
Dim VarMois As String
Dim Stat As String





Sub Etiquette()
Dim i As Integer
For i = 100 To 101
Set LabelClasses(i) = New LabelClasse
Set LabelClasses(i).Label = Me.Controls('Label' & i)
Next i
End Sub



Private Sub Appz_DropButtonClick()
ChargeComboAppz
End Sub


Private Sub Declar_DropButtonClick()
ChargeComboDeclar
End Sub



Private Sub Domaine_DropButtonClick()
ChargeComboDomaine
End Sub


Private Sub Impr_Click()
imprimerPlageCellules
End Sub
Sub imprimerPlageCellules()
Sheets(VarMois).Range('A1:Y50').PrintOut
End Sub


Private Sub Label105_Click()
UserForm1.Show

End Sub

Private Sub Label106_Click()

End Sub

Private Sub Label107_Click()

End Sub

Private Sub Mois_Change()
Mois = UCase(Mois) 'force les majuscules
If Mois.ListIndex = -1 Then
RemetAZéro
Exit Sub
End If

End Sub

Private Sub Mois_Click()
VarMois = Mois.Value
Nom_Change
End Sub

Private Sub Mois_DropButtonClick()
DerligneDonnées = Sheets(VarMois).Range('A65536').End(xlUp).Row
ChargeCombo
End Sub

Sub Nom_Change()
Nom = UCase(Nom) 'force les majuscules
If Nom.ListIndex = -1 Then

Exit Sub
End If
With Sheets(VarMois)
Prenom = .Range('B' & Nom.List(Nom.ListIndex, 1))
Declar = .Range('D' & Nom.List(Nom.ListIndex, 1))
Appz = .Range('E' & Nom.List(Nom.ListIndex, 1))
Lieu = .Range('F' & Nom.List(Nom.ListIndex, 1))
Domaine = .Range('G' & Nom.List(Nom.ListIndex, 1))
Adresse = .Range('H' & Nom.List(Nom.ListIndex, 1))
datereso = .Range('I' & Nom.List(Nom.ListIndex, 1))
Ville = .Range('J' & Nom.List(Nom.ListIndex, 1))
Statut = .Range('c' & Nom.List(Nom.ListIndex, 1))

End With
'etc...
'remplit les différents textbox quand nom change
End Sub


Private Sub label101_Click()
Dim Ligne As Integer
Ligne = DerligneDonnées + 1
If Nom.ListIndex <> -1 Then Ligne = Nom.List(Nom.ListIndex, 1)

With Sheets(VarMois)
.Range('A' & Ligne) = Nom
.Range('B' & Ligne) = Format(Prenom, 'dd-mmm')
.Range('C' & Ligne) = Application.Proper(Statut)
.Range('D' & Ligne) = Application.Proper(Declar)
.Range('E' & Ligne) = Format(Appz)
.Range('F' & Ligne) = Application.Proper(Lieu)
.Range('G' & Ligne) = Format(Domaine)
.Range('H' & Ligne) = Application.Proper(Adresse)
.Range('I' & Ligne) = Format(datereso, 'dd-mmm')
.Range('J' & Ligne) = UCase(Ville)


'etc...
'enregistre soit le nouveau soit la modif
DerligneDonnée = Sheets(VarMois).Range('A65536').End(xlUp).Row
End With
RemetAZéro
ChargeCombo 'remet à jour la liste du combo
End Sub

Private Sub label100_Click()
Unload Box
End Sub


Private Sub Nom_Click()
VarMois = Mois.Value

End Sub

Private Sub Nom_DropButtonClick()


DerligneDonnées = Sheets(VarMois).Range('A65536').End(xlUp).Row

End Sub


Private Sub Statut_DropButtonClick()
ChargeComboStatut
End Sub

Private Sub UserForm_Initialize()
Dim hWnd As Long, Style As Long
hWnd = FindWindow(vbNullString, Me.Caption)
Style = GetWindowLong(hWnd, -16) And Not &HC00000
SetWindowLong hWnd, -16, Style
DrawMenuBar hWnd
Etiquette '
ChargeComboMois
VarMois = Mois.Value
DerligneDonnées = Sheets(VarMois).Range('A65536').End(xlUp).Row
ChargeCombo

End Sub
Private Sub UserForm_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)

Dim i As Integer
On Error Resume Next
For i = 100 To 101
Controls('Label' & i).SpecialEffect = fmSpecialEffectFlat
Next i

End Sub
Sub ChargeCombo()
Nom.Clear

For i = 2 To DerligneDonnées
Nom.AddItem Sheets(VarMois).Range('A' & i)
Nom.List(i - 2, 1) = i

Next i

Me.Nom.List = ListSort(Me.Nom.List)
End Sub
Sub RemetAZéro()
Dim i As Integer
On Error Resume Next
For i = 1 To Me.Controls.Count
If Me.Controls.Item(i).Object = '' Then Me.Controls.Item(i) = ''

Next i


End Sub

Private Sub UserForm_Scroll(ByVal ActionX As Long, ByVal ActionY As Long, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)

End Sub

Public Sub ChargeComboMois()
Mois = 'JANVIER'

For i = 1 To 12
Mois.AddItem Sheets('Synthèse').Range('AD' & i)
Mois.List(i - 1, 1) = i

Next i

End Sub
Public Sub ChargeComboStatut()


For i = 2 To 5
Statut.AddItem Sheets('Synthèse').Range('m' & i)


Next i

End Sub

Public Sub ChargeComboAppz()


For i = 2 To 11
Appz.AddItem Sheets('Synthèse').Range('n' & i)


Next i

End Sub
Public Sub ChargeComboDeclar()


For i = 2 To 8
Declar.AddItem Sheets('Synthèse').Range('l' & i)


Next i

End Sub

Public Sub ChargeComboDomaine()


For i = 2 To 7
Domaine.AddItem Sheets('Synthèse').Range('o' & i)


Next i

End Sub

D'avance merci

 

[PascalXLD]

Re

Ce serait plus facile si tu mettais une partie du fichier zippé car là c'est pas facile (en plus tu as des prénoms au format dd-mmm ce qui fait qu'on est pas sur de ce qu'on fait)

 

[Thomas]

Merci d'avance

j'ai du supprimé les infos de mon tableau

 

[PascalXLD]

RE

il manque le fichier zippé avec zip en minuscules pas de caratères spéciaux ni accent et moins de 50 ko

 

[Thomas]

j'ai du sup plein de feuille mais mon fichier fait tjrs plus de 50ko

donc je l'ai découpé en 3
sorry pour l'espace

d'avance merci pour ton aide

 

[thomas]

j'y arrive en 2 [file name=thomas001.zip size=50000]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/thomas001.zip[/file]

 

[thomas]

le dernier

 

[thomas]

voilà!!

c'est la premiere fois que je join des fichiers

ce n'est pas facile.

d'avance merci [file name=thomas002.zip size=5567]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/thomas002.zip[/file]

 

[PascalXLD]

Re

Bon impossible d'extraire les fichiers ?? :sick:

 

[Thomas]

Bonjour et merci pour votre aide,

chez moi ca passe,

il faut copier les 2 dans le même dossier puis prendre le 2éme et le deszipper.

car c'est vrai que sur le 1er ca ne passe pas sinon dit le et je les renvois

 

[PascalXLD]

Bon

rien à faire je n'arrive pas à dezipper

 

[Thomas]

je les rejoind :ermm:

j'espere que ca irra sinon je devrais encore supprimer des feuille dans mon fichier mais dans ce cas le code n'aura plus aucun sens.

merci pou le temps que tu y consacre c'est vraiment simpa [file name=thomas002_20050318114722.zip size=5567]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/thomas002_20050318114722.zip[/file]

 

[Thomas]

bien prendre les 2 et dézipper le second [file name=thomas001_20050318114840.zip size=50000]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/thomas001_20050318114840.zip[/file]