N
nilses
Guest
Bonjour,
J'ai petit problème et j'aimerais avoir votre aide. Je récupére de Excel une requête croisée mais dans cette requête croisée j'ai un champ que je ne souhaite pas afficher. Je ne souhaite pas faire un hidden de ma colonne après l'affichage des données. Dans ma requête croisée j'ai donc deux champs, le premier un champ null et le deuxième n'est pas un champ vide. Dans mon code VBA, je saute le premier enregistrement et je n'affiche qu'à partir du deuxième enregistrement:
Le format de ma requête croisée:
Vide.....PROCASH2150
Null.....112
Mon problème est l'affichage. J'arrive à mettre un Border en haut et en bas de ma cellule mais pas à l'intérieur et pas sur les côtés. Pourriez vous m'aider.
J'ai ceci:
___________
PROCASH2150
112
-----------
et j'aimerais ceci mais je n'y arrive pas :-(
___________
|PROCASH2150|
|___________|
|112 |
|-----------|
Voici mon code:
Sub CopyFromRecordsetModules()
Dim Db1 As Database
Dim Rs1 As Recordset, Nb As Long
Dim Sh As Worksheet, Rg As Range, Nl As Range
Dim Chemin As String, Fichier As String
'Cette variable te permet de déterminer
'le type de bordure désiré...
Dim bordure As MsoLineStyle
'efface le signe égal...et lorsque tu
'le remplace, tu auras la liste des
'constantes disponibles
bordure = msoLineSingle
'Chemin = (ThisWorkbook.Path & "\")
'Fichier = "CaisseEpargnePC.mdb"
'utilise une variable pour la feuille
'et la première cellule où seront copiées les
'données...Ceci permet à ta procédure de s'exécuter
'sans avoir à préselectionner la feuille....
Set Sh = Worksheets("test")
With Sh
Set Rg = .Range("D8")
End With
'Définir le chemin de la base de données "ici en chemin absolu et non
relatif " à ouvrir
Set Db1 = DBEngine.OpenDatabase(ThisWorkbook.Path & "\CaisseEpargnePC.mdb")
'Définir la requête de la base de données à ouvrir
Set Rs1 = Db1.OpenRecordset("REPORTING: Tableau Modules MO9 Part2",
dbOpenDynaset)
'Efface toutes les données se trouvant dans la plage
'de cellules devant recevoir les nouvelles données.
Rg.CurrentRegion.Clear
'Rg.CurrentRegion.EntireRow.Interior.ColorIndex = 2
'Teste pour savoir si La table contient au moins 1 enregistrement
If Rs1.EOF = False Then
'Place dans une variable Nb le nombre
'champs que contient le recordset
Nb = Rs1.Fields.Count - 1
'Boucle pour inscrire le nom des champs dans
'la première ligne de ta plage de cellule
'Rg représente la première cellule...
For a = 1 To Nb
Rg(, a) = Rs1.Fields(a).Name
Next
'Met en gras, le texte de la ligne de titres...
'Rg.Resize(, Nb + 1).Font.Bold = True
'Rg.Resize(, Nb + 1).Interior.Color = 12
'Rg.Resize(, Nb + 1).ForeColor = 12
'Rg.Resize(, Nb + 1).Font.Color = 0
'copie les données du recordset vers la feuille...
Rg.Offset(1, -1).CopyFromRecordset Rs1
'Appplique la méthode autofit à l'ensemble de la plage
Rg.CurrentRegion.EntireColumn.AutoFit
Rg.CurrentRegion.WrapText = True
'Place une bordule couleur noir autour de la plage
Rg.Offset(1, -1).CurrentRegion.BorderAround bordure, xlHairline, 0
Rg.Offset(1, -1).CurrentRegion.Borders.LineStyle = xlContinuous
'Applique un centragehorizontale et verticale des champs des données
Sh.Range("A8:IV4").HorizontalAlignment = xlHAlignCenter
Sh.Range("A8:IV4").VerticalAlignment = xlVAlignCenter
'Applique un ajustement entre la colonne et son contenu
Sh.Range("A8:A65536").WrapText = False
'Modifie la largeur des colonnes de la plage pour l'ajuster au mieux.
Sh.Columns(1).AutoFit
'Applique une taille de marge précise
Sh.PageSetup.LeftMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.RightMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.TopMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.BottomMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.HeaderMargin = Application.CentimetersToPoints(0.5)
Sh.PageSetup.FooterMargin = Application.CentimetersToPoints(0.5)
'Ligne à répétées à gauche lors de l'impression
Sh.PageSetup.PrintTitleRows = ActiveSheet.Rows("1:8").Address
'Calculer la somme de chaque ligne
'Sh.Columns("C").Hidden = True
Else
'message si aucun enregistrement n'est trouvé.
MsgBox "Aucun enregistrement trouvé."
End If
'Libère l'espaces mémoire des objets utilisés
Set Rg = Nothing: Set Sh = Nothing
'Ferme le recordset et la base de données
Rs1.Close: Db1.Close
'Libère la mémoire des objets
Set Rs1 = Nothing: Set Db1 = Nothing
End Sub
Merci de votre aide
Nilses
J'ai petit problème et j'aimerais avoir votre aide. Je récupére de Excel une requête croisée mais dans cette requête croisée j'ai un champ que je ne souhaite pas afficher. Je ne souhaite pas faire un hidden de ma colonne après l'affichage des données. Dans ma requête croisée j'ai donc deux champs, le premier un champ null et le deuxième n'est pas un champ vide. Dans mon code VBA, je saute le premier enregistrement et je n'affiche qu'à partir du deuxième enregistrement:
Le format de ma requête croisée:
Vide.....PROCASH2150
Null.....112
Mon problème est l'affichage. J'arrive à mettre un Border en haut et en bas de ma cellule mais pas à l'intérieur et pas sur les côtés. Pourriez vous m'aider.
J'ai ceci:
___________
PROCASH2150
112
-----------
et j'aimerais ceci mais je n'y arrive pas :-(
___________
|PROCASH2150|
|___________|
|112 |
|-----------|
Voici mon code:
Sub CopyFromRecordsetModules()
Dim Db1 As Database
Dim Rs1 As Recordset, Nb As Long
Dim Sh As Worksheet, Rg As Range, Nl As Range
Dim Chemin As String, Fichier As String
'Cette variable te permet de déterminer
'le type de bordure désiré...
Dim bordure As MsoLineStyle
'efface le signe égal...et lorsque tu
'le remplace, tu auras la liste des
'constantes disponibles
bordure = msoLineSingle
'Chemin = (ThisWorkbook.Path & "\")
'Fichier = "CaisseEpargnePC.mdb"
'utilise une variable pour la feuille
'et la première cellule où seront copiées les
'données...Ceci permet à ta procédure de s'exécuter
'sans avoir à préselectionner la feuille....
Set Sh = Worksheets("test")
With Sh
Set Rg = .Range("D8")
End With
'Définir le chemin de la base de données "ici en chemin absolu et non
relatif " à ouvrir
Set Db1 = DBEngine.OpenDatabase(ThisWorkbook.Path & "\CaisseEpargnePC.mdb")
'Définir la requête de la base de données à ouvrir
Set Rs1 = Db1.OpenRecordset("REPORTING: Tableau Modules MO9 Part2",
dbOpenDynaset)
'Efface toutes les données se trouvant dans la plage
'de cellules devant recevoir les nouvelles données.
Rg.CurrentRegion.Clear
'Rg.CurrentRegion.EntireRow.Interior.ColorIndex = 2
'Teste pour savoir si La table contient au moins 1 enregistrement
If Rs1.EOF = False Then
'Place dans une variable Nb le nombre
'champs que contient le recordset
Nb = Rs1.Fields.Count - 1
'Boucle pour inscrire le nom des champs dans
'la première ligne de ta plage de cellule
'Rg représente la première cellule...
For a = 1 To Nb
Rg(, a) = Rs1.Fields(a).Name
Next
'Met en gras, le texte de la ligne de titres...
'Rg.Resize(, Nb + 1).Font.Bold = True
'Rg.Resize(, Nb + 1).Interior.Color = 12
'Rg.Resize(, Nb + 1).ForeColor = 12
'Rg.Resize(, Nb + 1).Font.Color = 0
'copie les données du recordset vers la feuille...
Rg.Offset(1, -1).CopyFromRecordset Rs1
'Appplique la méthode autofit à l'ensemble de la plage
Rg.CurrentRegion.EntireColumn.AutoFit
Rg.CurrentRegion.WrapText = True
'Place une bordule couleur noir autour de la plage
Rg.Offset(1, -1).CurrentRegion.BorderAround bordure, xlHairline, 0
Rg.Offset(1, -1).CurrentRegion.Borders.LineStyle = xlContinuous
'Applique un centragehorizontale et verticale des champs des données
Sh.Range("A8:IV4").HorizontalAlignment = xlHAlignCenter
Sh.Range("A8:IV4").VerticalAlignment = xlVAlignCenter
'Applique un ajustement entre la colonne et son contenu
Sh.Range("A8:A65536").WrapText = False
'Modifie la largeur des colonnes de la plage pour l'ajuster au mieux.
Sh.Columns(1).AutoFit
'Applique une taille de marge précise
Sh.PageSetup.LeftMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.RightMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.TopMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.BottomMargin = Application.CentimetersToPoints(1)
Sh.PageSetup.HeaderMargin = Application.CentimetersToPoints(0.5)
Sh.PageSetup.FooterMargin = Application.CentimetersToPoints(0.5)
'Ligne à répétées à gauche lors de l'impression
Sh.PageSetup.PrintTitleRows = ActiveSheet.Rows("1:8").Address
'Calculer la somme de chaque ligne
'Sh.Columns("C").Hidden = True
Else
'message si aucun enregistrement n'est trouvé.
MsgBox "Aucun enregistrement trouvé."
End If
'Libère l'espaces mémoire des objets utilisés
Set Rg = Nothing: Set Sh = Nothing
'Ferme le recordset et la base de données
Rs1.Close: Db1.Close
'Libère la mémoire des objets
Set Rs1 = Nothing: Set Db1 = Nothing
End Sub
Merci de votre aide
Nilses
