Renseignements & Conseils

Bonjour à tous,

Je me permets de vous solliciter, car vous êtes les dernières personnes à pourvoir répondre à mes questions. J’ai posté plusieurs questions sur différents forums en France et aux USA mais sans résultat. Je suis même allé à la FNAC mais aussi sans résultat !!!

Je n’ai trouvé personne pour répondre à cette question. La seule réponse est de passer par le mise en forme conditionnelle sans passer par le code VBA. Je souhaite faire de la mise en forme conditionnelle mais uniquement par VBA. Je récupère des données d’une table Access et je souhaite faire de la mise en forme conditionnelle automatique sans que la personne puisse taper une formule dans l’option mise en forme conditionnelle. Mon code ci-dessous marche mais il met en rouge que la case = DC ou la case = DHC. Je souhaite mettre en couleur la ligne entière jusqu'à la dernière cellule où se trouvent des données, je n’ai pas trouvé d’information sur ce sujet.

Voici le code que j’utilise pour mettre rouge par exemple une cellule contenant « DC » mais cela ne marche pas pour toute la ligne.

Set thisrange = Rg.Range("A4").CurrentRegion
For Each Cell In thisrange
If Cell.Value = "DC" Then
Cell.Select
With Selection
.Interior.ColorIndex = 3
End With
ElseIf Cell.Value = "VANDALISME" Then
Cell.Select
With Selection
.Interior.ColorIndex = 4
End With
End If
Next Cell


- J'ai un petit problème avec la procédure Sub Insérer_Image. L'image se charge à chaque fois lorsque j'ouvre mon fichier Excel. Si j'ouvre et je referme 4 fois mon fichier, j'aurais 4 fois la même image l'une sur l'autre. Comment faire pour vérifier si cette image existe dans ma feuille et si oui, l'image ne se charge pas .

Sub InsertPicture()

Dim Sh As Worksheet, Rg As Range, Image As Object
Set Sh = Worksheets("MySheet")
Set Rg = Sh.Range("A1")

With Rg
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = Sh.Pictures.Insert(ThisWorkbook.Path & "\Hello.gif")
With Image
.Left = Rg.Left
.Top = Rg.Top
.ShapeRange.ScaleHeight 0.045, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleWidth 0.24, msoFalse, msoScaleFromTopLeft
.Width = Largeur
.Height = Hauteur
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
.Locked = True 'or False
End With
End With
Set Rg = Nothing: Set Sh = Nothing: Set Image = Nothing

End Sub


Ma dernière question est la suivante. Si j’utilise tout ce code et que j’envoie le fichier Excel, Excel va garder le code dans son fichier et donc lorsqu’une personne va ouvrir ce fichier sur son ordinateur, Excel va vouloir chercher les données. Comment garder en mémoire les données et couper la liaison entre Access et Excel ?.


Voici le code que j’utilise dans son intégralité à titre d'information:

Sub CopyFromRecordset_DAO()

Dim Db1 As Database
Dim Rs1 As Recordset, Nb As Long
Dim Sh As Worksheet, Rg As Range, Nl As Range

Dim border As MsoLineStyle

border = msoLineSingle

Set Sh = Worksheets("MySheet")
With Sh
Set Rg = .Range("A4")
End With

Set Db1 = DBEngine.OpenDatabase(ThisWorkbook.Path & "\MyDataBase.mdb")

Set Rs1 = Db1.OpenRecordset("MyQuery", dbOpenTable)

Rg.CurrentRegion.Clear

If Rs1.EOF = False Then

Nb = Rs1.Fields.Count - 1

For a = 0 To Nb
Rg(, 1 + a) = Rs1.Fields(a).Name
Next

Rg.Resize(, Nb + 1).Font.Bold = True

Rg.Offset(1).CopyFromRecordset Rs1

Rg.CurrentRegion.EntireColumn.AutoFit

Rg.CurrentRegion.BorderAround border, xlHairline, 0

Rg.CurrentRegion.Borders.LineStyle = xlContinuous

With Worksheets("Feuille1").Range("B2:G2")
.Merge (Across)
.Value = "ça marche !!!"
.Borders.LineStyle = xlContinuous
.Font.Size = 14
.Font.Bold = True
End With

Worksheets("MySheet").Range("A4:IV4").HorizontalAl ignment = xlHAlignCenter
Worksheets("MySheet").Range("A4:IV4").VerticalAlig nment = xlVAlignCenter

Worksheets("MySheet").PageSetup.LeftMargin = Application.CentimetersToPoints(1)
Worksheets("MySheet").PageSetup.RightMargin = Application.CentimetersToPoints(1)
Worksheets("MySheet").PageSetup.TopMargin = Application.CentimetersToPoints(1)
Worksheets("MySheet").PageSetup.BottomMargin = Application.CentimetersToPoints(1)
Worksheets("MySheet").PageSetup.HeaderMargin = Application.CentimetersToPoints(0.5)
Worksheets("MySheet").PageSetup.FooterMargin = Application.CentimetersToPoints(0.5)

Worksheets("MySheet").PageSetup.PrintTitleRows = ActiveSheet.Rows("1:4").Address

Set thisrange = Rg.Range("A4").CurrentRegion
For Each Cell In thisrange
If Cell.Value = "DC" Then
Cell.Select
With Selection
.Interior.ColorIndex = 3
End With
ElseIf Cell.Value = "VANDALISME" Then
Cell.Select
With Selection
.Interior.ColorIndex = 4
End With
End If
Next Cell

Else

MsgBox "No Record !!"
End If

Set Rg = Nothing: Set Sh = Nothing

Rs1.Close: Db1.Close

Set Rs1 = Nothing: Set Db1 = Nothing
End Sub


Merci de votre aide

Nilses

Bonsoir,


Pour la 1ère question, essaye avec :


If cell.Value = "DC" Then
ligne = cell.Row
Range("A" & ligne).Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
With Selection
.Interior.ColorIndex = 3
End With


@+

Merci Alain pour ton conseil,

Je vais essayer dès que possible

merci ;-)

Nilses

plutot que ce long bout de code, tu devrais mettre un fichier d'exemple. Ca nous éviterait, d'une part, de passer chacun 1/2 heure à essayer de recréer ton fichier, et d'autre part, d'éviter bien des erreurs

oups, ma syntaxe est un peu défaillante ce soir...

Bonjour à tous,

Je pense que tu as entiérement raison Ti, je le ferais dés demain car je ne peux pour l'instant mettre un exemple. J'ai une question plus technique sur excel. Je charge mes données par du code VBA, Access vers Excel. si je souhaite envoyer ce fichier à un pote, quand il va ouvrir le fichier le code VBA va vouloir chercher les données. Est il possible de chercher les données une seule fois. Comment dois je faire pour qu'il ne voit pas qu'il existe du code VBA dans le fichier Excel?. Comment feriez vous ?. Que dois je faire pour simplement stoker les données. Dois je faireb une copie de mon fichier excel?.

Concernant mon image, est il possible de voir si il existe une image (par son nom par exemple) dans une feuille et si oui la supprimer. Quand je fais insérer une image sans passer par le code, comment il enregistre l'image, il la stocke?.

Merci de votre aide

Nilses