récupéré cellules par macro dans box

[malcy45]

bonjour tout le monde,
j'ai besoin de faire apparaitre dans une box deux cellules bien precises qui me donnent un pourcentage, une liaison en collage special ne me suffit pas.
le nom du fichier change de mois en mois mais le reste est fixe (nom de feuille et numeros de cellule)
tout est expliqué sur le fichier joint
Merci pour votre collaboration
Bonne journée a toutes et a tous
Cordialement
Rémi

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonsoir à tous
Bonsoir Rémi

J'ai récupérer ce code que tu dois à améliorer. Celui ci est de Frédéric Sigonneau qui le propose parmi plusieurs solutions :

Sub test()
anneeactuelle = Year(Date) 'j'ai ajouté
moisactuel = Month(Date) 'j'ai ajouté
GetValuesFromAClosedWorkbook "C:", "RH" & anneeactuelle & "_" & "0" & moisactuel & ".xls", "MOIS EN COURS", "A1:A1" 'cellule source
End Sub

Sub GetValuesFromAClosedWorkbook(fPath As String, _
fName As String, sName, cellRange As String)
'le paramètre 'cellRange' doit désigner
'*une* plage de cellules *contigües*
With ActiveSheet.Range("A1") 'cellule destination
.Formula = "='" & fPath & "\[" & fName & "]" _
& sName & "'!" & cellRange
.Value = .Value
End With
End Sub

J'ai testé et cela fonctionne chez moi

A+

Eric

 

[malcy45]

Re : récupéré cellules par macro dans box

bonjour eric
je regarde et te dis
merci

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonjour à tous
Bonjour Rémi

Après quelques essais, je joins un fichier plus adapté à tes besoins , si j'ai bien compris, toujours récupéré sur le site de Frédéric Sigonneau, MERCI à lui

A+

Eric

 

[malcy45]

Re : récupéré cellules par macro dans box

re éric,

je vais essayer la macro lundi au travail, je crois comprendre le cheminement donc je te dis ca des lundi merci pour les deux envois et bon week end.
Amicalement
rémi

 

[malcy45]

Re : récupéré cellules par macro dans box

BONJOUR LE FORUM ET BONJOUR ERIC,

je viens de tester les deux envois et j'ai adapté la macro a mon emplacement de fichier, un probleme apparait :

les cellules que je recopie sont des pourcentages et que la box me fait donc apparaitre un chiffre du style 0,0076458965 pour 0,76%
Comment puis je y remedier ???

Je vous joins les lignes de code modifiées pour que l un d'entre vous puisse me dire ; merci a tous du temps consacré.

Cordialement
Rémi

Sub test()
Dim fich$, feuil$, Cell As Range

anneeactuelle = Year(Date)
moisactuel = Month(Date)

fich = "H:\PCS CONTROLE\ANNEE 2007\TABLEAUX RH 2007\" & "RH" & anneeactuelle & "_" & "0" & moisactuel & ".xls"

feuil = "MOIS EN COURS"
Set Cell = Range("O6") '1ère cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
End If
Set Cell = Range("O46") '2ème cellule source
valeur = valeur & " / " & GetValueWithADO(fich, feuil, Cell)
MsgBox valeur

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:\TestADO.xls";"feuil1";A1)

Function GetValueWithADO(Classeur$, Feuille$, Cell As Range)
'renvoie la valeur de la cellule Cell de la feuille Feuille
'du classeur fermé Classeur
Dim RcdSet As Object
Dim strConn As String
Dim strCmd As String
Dim dummyBase As Range

'prépare une "base de données" bidon pour la clause SELECT
'(une entête fictive et une ligne de données)
Set dummyBase = Cell.Resize(2)

'prépare les commandes ADO et SQL
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Classeur & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
strCmd = "SELECT * FROM [" & Feuille & "$" & dummyBase.Address(0, 0) & "]"

'crée l'objet Recordset
Set RcdSet = CreateObject("ADODB.Recordset")

'va chercher l'info
RcdSet.Open strCmd, strConn, 0, 1, 1 'adOpenForwardOnly, adLockReadOnly, adCmdText

'et la renvoie
GetValueWithADO = Application.Clean(RcdSet(0))
'autre syntaxe possible
' GetValueWithADO =Application.Clean(RcdSet.GetString(NumRows:=1))

'nettoyage
Set RcdSet = Nothing
End Function 'fs

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonjour à tous
Bonjour Rémi

Je viens juste de lire ta réponse. Je te propose ce code :

après la ligne : " valeur = GetValueWithADO(fich, feuil, Cell) "

tu ajoutes :
valeur = "0," & Mid(valeur, 5, 2)
mavaleur = CDbl(valeur)

soit la 1ère ligne, pour du texte uniquement, soit les 2 et tu récupères un nombre.

Je sais c'est un peu capilotracté mais cela fonctionne, tout dépend ce que tu veux faire après.

Il y a peut être une solution pour récupérer directement un nombre à la place de "GetValueWithADO(fich, feuil, Cell) ", mais je ne connais pas.

A+

Eric

 

[malcy45]

Re : récupéré cellules par macro dans box

bonjour eric
je viens de rentrer de quelques jours de repos bien mérité et je m y colle des demain et je te tiens au courant.
Amities
Rémi

 

[malcy45]

Re : récupéré cellules par macro dans box

coucou le forum et eric,

j ai essayé d'ajouter ta ligne de code et je me retrouve avec le chiffre de gauche a deux chiffres derriere la virgule mais le second chiffre reste avec ses 6 chiffres apres la virgule donc je ne solutionne qu une partie de mon probleme j aimerai surtout avoir la meme valeur que dans la case O6 et O46
donc si quelqu un a une idée, bien sur je suis preneur mais je voudrai bien y arriver avec toi éric.

feuil = "MOIS EN COURS"
Set Cell = Range("O6") '1ère cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
valeur = "0," & Mid(valeur, 5, 2)
mavaleur = CDbl(valeur)

End If

Set Cell = Range("O46") '2ème cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
End If
valeur = valeur & " / " & GetValueWithADO(fich, feuil, Cell)
MsgBox valeur

Merci
Rémi

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonsoir à tous
Bonsoir Rémi

Si ma solution te va pour la première cellule il faut refaire la même manip pour la seconde.

A+

Eric

 

[malcy45]

Re : récupéré cellules par macro dans box

bonjour eric,
oui bien sur qu elle me va
et bien sur que j'ai essaye pour la seconde en recopiant la meme ligne mais le resultat est plutot bizarre car la box ne me laisse apparaitre qu une seule valeur a la place des deux precedentes ; il est fort probable que je ne la recopie pas au bon endroit donc je retourne tout a l heure au travail et te tiens au courant mais je crois deja que je viens de comprendre mon erreur !!!
a plus
cordialement
rémi

 

[malcy45]

Re : récupéré cellules par macro dans box

re eric et le forum
je te met les lignes modifiées chez moi et hélas je me retrouve toujours avec la meme erreur
a toi de me dire ou je me trompe merci

feuil = "MOIS EN COURS"
Set Cell = Range("O6") '1ère cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
valeur = "0," & Mid(valeur, 4, 3)
End If
Set Cell = Range("O46") '2ème cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
valeur = "0," & Mid(valeur, 4, 3)
End If

voila grand merci
rémi

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonjour à tous
Bonjour Rémi

avec ce code, cela devrait fonctionner :

feuil = "MOIS EN COURS"
Set Cell = Range("O6") '1ère cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
mavaleur01 = "0," & Mid(valeur, 4, 3)
End If
Set Cell = Range("O46") '2ème cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
mavaleur02 = "0," & Mid(valeur, 4, 3)
End If
mavraivaleur = mavaleur01 & " / " & mavaleur02  'ligne uniquement pour vérifier, 
  'à supprimer si tu mets msgbox mavaleur01 & " / " & mavaleur02

msgbox mavraivaleur

A+

Eric

 

[malcy45]

Re : récupéré cellules par macro dans box

re eric
et bien helas, cela ne semble pas fonctionner alors j ai pris la liberte de creer deux message box avec une box pour chaque cellule et je m'en sors de cette maniere.

J aimerai quand meme comprendre pourquoi cela ne fonctionne pas avec ta nouvelle formule je me retrouve avec une resultat :

0,133/ (vide) en mettant cette formule


feuil = "MOIS EN COURS"
Set Cell = Range("O6") '1ère cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
mavaleur01 = "0," & Mid(valeur, 4, 3)
End If
Set Cell = Range("O46") '2ème cellule source
If valeur = "" Then
valeur = GetValueWithADO(fich, feuil, Cell)
mavaleur02 = "0," & Mid(valeur, 4, 3)
End If

MsgBox mavaleur01 & " / " & mavaleur02

mais idem avec la formule que tu m'avais laissée
a toi de me dire

 

[Eric 45]

Re : récupéré cellules par macro dans box

Bonsoir à tous
Bonsoir rémi

Désolé je ne vois pas pourquoi j'ai inclus des "if", supprime les, et cela devrait fonctionner.

A+

Cordialement Eric