Forums XLPages

Tous les messages (Eric)

« 1 ... 11 12 13 14
Re: Aide sur code
#131
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 14-05-2009 15h37
Bonjour à tous
Bonjour Kelly

La petite modif demandée ainsi que quelques explications pour le code.

On remet la cellule à "rien". Le Module modifié :

Option Explicit

Public KO As Boolean
Public ma_feuille As String
Public macol
Public maligne
Public trouve As Integer
Public valeur_cellule 'As String

Sub recherche()

Dim a As Integer
Dim i As Integer
Dim pos As Integer

'recherche de la colonne modifi�e
Select Case macol
    Case 3, 7, 11, 15, 19, 23   'N� des colonnes "matin" ou "apr�m"
        a = 3                   'N� de la 1�re colonne
    Case 5, 9, 13, 17, 21, 25   'N� des colonnes "matin" ou "apr�m"
        a = 5                   'N� de la 1�re colonne
End Select

'tests sur les 6 colonnes "matin" ou "apr�m"
For i = 0 To 5
    If macol <> a + (i * 4) Then    'pas de test sur la colonne actuelle
        If Worksheets(ma_feuille).Cells(maligne, a + (i * 4)) <> "" Then
            If InStr(valeur_cellule, CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4)))) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: ActiveCell.Value = "": Exit Sub
                'test si dans la cellule actuelle il y a la chaine des 5 autres cellules => valeur_cellule = PC1+PC2 et les autres PC1 (exemple)
            If InStr(CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4))), valeur_cellule) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: ActiveCell.Value = "": Exit Sub
                'test si dans les 5 autres cellules il y a la chaine de la cellule actuelle => valeur_cellule = PC1 et les autres PC1+PC2 (exemple)
         End If
    End If
Next i

End Sub

Sub materiel()
Dim i As Integer
Dim lalong As Integer
Dim valeur_cellule_intermediaire
Dim pos As Integer

'on d�coupe la cellule actuelle : PC1 + sono
If InStr(valeur_cellule, "+") <> 0 Then     'test si il y a un "+" dans la cellule actuelle
    valeur_cellule_intermediaire = valeur_cellule
    lalong = Len(valeur_cellule)            'nombre de caract�res
    pos = InStr(valeur_cellule, "+")        'position du caract�re "+"
    valeur_cellule = Left(valeur_cellule_intermediaire, pos - 2)           'r�cup�ration de la chaine qui se trouve � gauche du +, en otant l'espace
    recherche
    If trouve = 1 Then Exit Sub
    valeur_cellule = Right(valeur_cellule_intermediaire, lalong - pos - 1) 'r�cup�ration de la chaine qui se trouve � droite du +, en otant l'espace
    recherche
Else
    recherche
End If

End Sub
 


Pour le code de la feuille, pas de modif.

Eric
Hors Ligne
 Rapport   Haut 

Re: Aide sur code
#132
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 13-05-2009 20h17
Bonsoir à tous
Bonsoir Kelly

Le code du module modifié :
ption Explicit

Public KO As Boolean
Public ma_feuille As String
Public macol
Public maligne
Public trouve As Integer
Public valeur_cellule 'As String

Sub recherche()

Dim a As Integer
Dim i As Integer
Dim pos As Integer

Select Case macol
    Case 3, 7, 11, 15, 19, 23
        a = 3
    Case 5, 9, 13, 17, 21, 25
        a = 5
End Select

For i = 0 To 5
    If macol <> a + (i * 4) Then
        If Worksheets(ma_feuille).Cells(maligne, a + (i * 4)) <> "" Then
            If InStr(valeur_cellule, CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4)))) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: Exit Sub
            If InStr(CStr(Worksheets(ma_feuille).Cells(maligne, a + (i * 4))), valeur_cellule) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": trouve = 1: Exit Sub
        End If
    End If
Next i

End Sub

Sub materiel()
Dim i As Integer
Dim lalong As Integer
Dim valeur_cellule_intermediaire
Dim pos As Integer

If InStr(valeur_cellule, "+") <> 0 Then
    valeur_cellule_intermediaire = valeur_cellule
    lalong = Len(valeur_cellule)
    pos = InStr(valeur_cellule, "+")
    valeur_cellule = Left(valeur_cellule_intermediaire, pos - 2)
    recherche
    If trouve = 1 Then Exit Sub
    valeur_cellule = Right(valeur_cellule_intermediaire, lalong - pos - 1)
    recherche
Else
    recherche
End If

End Sub
 

Le code de la Feuille modifié :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Value = "" Then Exit Sub

ma_feuille = ActiveSheet.Name
macol = Target.Column
maligne = Target.Row
valeur_cellule = Target.Value

'recherche
materiel

End Sub

Si tu dois ajouter d'autres matériels, il faudra peut-être ajuster. Pour l'instant, cela doit (!) fonctionner avec PC1 et autre PC1 + sono, cad avec un + entouré d'espaces.

Eric
Hors Ligne
 Rapport   Haut 

Re: Aide sur code
#133
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 12-05-2009 19h46
Bonsoir à tous
Bonsoir Kelly

Ce que je t'ai déposé ne fonctionne pas pour tous les cas. Celui-ci, j'ai pu le tester et il a l'air de fonctionner. J'espère que c'est ce que tu recherches.
Tu déposes dans un module standard ceci :
Option Explicit

Public KO As Boolean
Public ma_feuille As String
Public macol
Public maligne
Public valeur_cellule 'As String

Sub recherche()

Dim a As Integer
Dim i As Integer

Select Case macol
    Case 3, 7, 11, 15, 19, 23
        a = 3
    Case 5, 9, 13, 17, 21, 25
        a = 5
End Select

For i = 0 To 5
    If macol <> a + (i * 4) Then
        If Worksheets(ma_feuille).Cells(4, a + (i * 4)) <> "" Then
            If InStr(valeur_cellule, CStr(Worksheets(ma_feuille).Cells(4, a + (i * 4)))) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": Exit Sub
            If InStr(CStr(Worksheets(ma_feuille).Cells(4, a + (i * 4))), valeur_cellule) <> 0 Then MsgBox "Ce mat�riel est d�j� r�serv� sur cette p�riode !": Exit Sub
        End If
    End If
Next i

End Sub
 

et dans "Private Sub Worksheet_Change" de chaque feuille :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target(1).Value = "" Then Exit Sub

ma_feuille = ActiveSheet.Name
macol = Target.Column
maligne = Target.Row
valeur_cellule = Target.Value

recherche
End Sub
 

On peut améliorer, mais je n'ai pas eu le temps.

Dis nous

Eric
Hors Ligne
 Rapport   Haut 

Re: Aide sur code
#134
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 12-05-2009 00h01
Bonsoir à tous
Bonsoir Kelly

Tu peux ajouter ceci :
   With Worksheets("Janvier").Range(maligne)   'modifier Janvier, maligne = Target(1).Row & ":" & Target(1).Row
    Set d = .Find(a, LookIn:=xlValues, Lookat:=xlPart)   'a = variable recherchéeTarget(1).Value
        If Not d Is Nothing Then
            KO = True
        End If
    End With

Eric
Hors Ligne
 Rapport   Haut 

Re: Aide sur code
#135
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 09-05-2009 17h23
Bonjour à tous
Bonjour Kelly

Dans le fichier joint, le code VBA est protégé, pas facile de t'aider ...

Eric
Hors Ligne
 Rapport   Haut 

Re: Carte de mDF XLmap
#136
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 19-01-2009 16h52
Bonjour à tous
Bonjour Didier

Désolé pour cette réponse un peu tardive mais, d'une part je n'ai pas eu de message comme quoi il y avait une réponse sur le site (?), mais également je n'ai pas eu internet pendant 2 jours.

Merci pour ta réponse qui ne me ravit pas grandement tu t'en doutes. Mes capacités actuelles sont peut être loin d'être suffisantes pour arriver à mon but, mais je vais m'y atteler.

Eric
Hors Ligne
 Rapport   Haut 

Carte de mDF XLmap
#137
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 16-01-2009 11h12

Bonjour à tous

 

Ayant essayé le fichier exemple  "mDF_ExempleVirtualEarth" j'aimerai savoir s'il était possible d'obtenir, à la place de la carte " Virtual Earth de Microsoft", la carte de "GéoPortail" qui est beaucoup plus précise sur le territoire français, en particulier en forêt ?

 

J'ai bien vu et surtout lu qu'il fallait un API. Il existe bien un API GéoPortail, mais, si j'ai bien compris, il  est donné pour n'être utilisé que sur un "site internet", donc ce ne serait pas la solution.

 

J'ai bien essayé de changer le lien dans le fichier "ve_connexion.html", mais …. échec

 

Merci par avance de vos réponses

 

Eric
Hors Ligne
 Rapport   Haut 

Re: Texte de différentes couleurs dans un Label
#138
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 14-12-2008 13h51
Bonjour le forum
Bonjour Didier

Merci pour le richtextbox. Comme c'est pour un fichier perso, je vais me documenter sur ce contrôle.

Tu as raison pour l'usine à gaz qui pointe son nez

Bon dimanche à tous

Amitiés à toi, madame, et plein de bisous à tes 'tit'puces

Eric
Hors Ligne
 Rapport   Haut 

Re: Texte de différentes couleurs dans un Label
#139
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 14-12-2008 12h50
Bonjour à tous
Bonjour Skoobi

Avec un peu de retard, je te remercie de ta réponse. Je me doutais bien que pour "label" ce n'était pas "faisable", mais on peut toujours espérer.

"....Je crois qu'il existe un contrôle, je ne sais plus lequel, qui permet de le faire mais qui n'existe pas en "standard"....."  je garde espoir donc, et vais chercher.

Je vais me diriger sur la création de labels dynamiquement mais j'aurais préféré une autre solution, car celle ci n'est pas des plus adéquates.

Bon dimanche

Eric
Hors Ligne
 Rapport   Haut 

Texte de différentes couleurs dans un Label
#140
Eric
Semi pro XLPages

Inscription: 12/06/2008
De Ile de France Sud

Messages: 140

Système d'exploitation:
PC
Version Excel utilisée:
2003 _ 2010
Posté le : 11-12-2008 22h32

Bonjour à tous

 

Voilà une partie de mon code :

...
With Worksheets("releves").Range("h5:h1000")
    Set c = .Find("*", LookIn:=xlValues)
        firstAddress = c.Address
        Do
            If  mavar <> "" Then
                If IsNumeric(Range("h" & c.Row).Value) Then mavar = mavar & " / " & Range("h" & c.Row).Value
               
            Else
                mavar = "Les variations sont : " & Range("h" & c.Row).Value
            End If
             Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
End With

Label4.Caption = mavar
....
 


Ce que j'aimerais obtenir dans le label4 :  Les variations sont : 22 / 55.25 / 33 / 5.8 / 2.4

 

Les couleurs de la police des cellules doivent être récupérées. Pour l'instant j'ai 2 couleurs : rouge et automatique. Dans l'exemple, les 2,4 et 5ème sont des valeurs de cellules à fonte rouge

 

Donc : est-ce possible de mettre un texte de différentes couleurs dans un label de USF, et si oui …….comment

 

Merci d'avance

 

Eric
Hors Ligne
 Rapport   Haut 

« 1 ... 11 12 13 14