[Edition] Disparition de quelques bordures
M
Bonjour,
J'ai un mystère que je n'arrive pas à résoudre seul concernant des éditions.
Je joins également le rendu en PDF pour les deux codes. Dans le 1er cas c'est propre, dans le 2ème cas, certaines bordures sont manquantes...
1er cas: Prévisualisation pour impression ou enregistrement PDF d'une ou plusieurs feuilles depuis Excel
Code associé (les tempos sont là pour gérer le masquage des deux premières lignes durant la prévisualisation, rien trouvé de mieux pour l'instant ^^)
Sub Btn_Aperçu_Impression_Checkpoint()
Attente = Now + TimeValue("00:00:20")
Attente_Selection = Now + TimeValue("00:00:01")
ScreenUpdating = False
With ActiveSheet
Rows("1:2").EntireRow.Hidden = True
If Range("J13") = "" Then
Columns("I:M").EntireColumn.Hidden = True
End If
End With
With ActiveSheet
Rows("1:2").EntireRow.Hidden = False
Columns("I:M").EntireColumn.Hidden = False
End With
Application.OnTime Attente, "Tempo_Checkpoint"
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
ScreenUpdating = True
End Sub2ème cas: Génération d'un PDF à intégrer dans un mail en PJ pour envoi
Code associé
Sub Envoi_Checkpoint_CR_ToPDF_ToMail()
Dim sPath As String, sFileName As String, ShtName As String
Dim OutObj As Object, Email As Object
DateCP = Range("DateCP").Value
ComiteCP = Range("ComiteCP").Value
NumeroCP = Range("NumeroCP").Value
With activesheets
Rows("1:2").EntireRow.Hidden = True
If Range("J13") = "" Then
Columns("I:M").EntireColumn.Hidden = True
End If
' Initialisation des variables
' Chemin d'accès du dossier TEMP
sPath = Environ("TEMP") & "\"
' Nom du fichier à envoyer par mail
sFileName = "[" & Range("NomProjet").Value & "]" & " " & "CR Checkpoint" & " " & Range("J4").Value & ComiteCP & NumeroCP & ".pdf"
' Vérifier l'extension du fichier à enregistrer
If Right(sFileName, 4) <> ".pdf" Then sFileName = sFileName & ".pdf"
' Nom de la feuille à exporter en PDF
ShtName = ActiveSheet.Name
'
' 1) Générer le PDF dans le répertoir temporaire de l'utilisateur
Sheets(ShtName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sFileName, _
Quality:=xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, openafterpublish:=False
Rows("1:2").EntireRow.Hidden = False
Columns("I:M").EntireColumn.Hidden = False
'
' 2) Créer le mail et joindre le fichier
' Création d'une instance Outlook pour envoyer un mail
Set OutObj = CreateObject("Outlook.Application")
Set Email = OutObj.CreateItem(0)
' Avec mon objet Email
With Email
.Display ' Afficher le mail pour afficher la signature
' Destinataire(s) du mail
.To = Range("Dest1CP").Value & ";" & Range("Dest2CP").Value & ";" & Range("Dest3CP").Value & ";" & Range("Dest4CP").Value & ";" & Range("Dest5CP").Value & ";" & Range("Dest6CP").Value & ";" & Range("Dest7CP").Value & ";" & Range("Dest8CP").Value
' Copie du mail
.CC = Range("Cc1CP").Value & ";" & Range("Cc2CP").Value & ";" & Range("Cc3CP").Value & ";" & Range("Cc4CP").Value
' Sujet de l'eMail°
.Subject = "[" & Range("NomProjet").Value & "]" & " " & "CR Checkpoint" & " " & Range("J4").Value & ComiteCP & NumeroCP
' Corps du mail avec signature à la fin
.Body = "Bonjour," & vbNewLine & _
vbNewLine & _
"Veuillez trouver ci-joint le compte rendu de notre dernier checkpoint." & vbNewLine & _
vbNewLine & _
"Bien à vous,"
' Joindre le fichier précédemment créé
.Attachments.Add sPath & sFileName
' Envoyer l'email
'.Send
End With
End With
' Effacer les variable objet
Set Email = Nothing: Set OutObj = Nothing
' Supprimer le fichier du répertoire temporaire
Kill sPath & sFileName
'Sheets("Checkpoint_CR").Select
End SubQuelqu'un a t'il une idée svp ? :)
Merci beaucoup pour votre temps.
Matths
M
Bonjour Bruno,
Merci pour ta réponse.
Moi je veux bien la refaire mais je ne sais pas quoi modifié car dans un cas comme dans l'autre la bordure est déjà appliquée avec l'édition.
Donc selon toi, il faut que, dans la procédure de prévisualisation, je fasse une boucle qui balaye les lignes non vides pour y appliquer une nouvelle fois une bordure ?
Merci
M
Je viens d'ajouter des boucles dans mon cas 2, pour refaire un passage sur les cellules non vides et leur mettre une nouvelle bordure: j'ai toujours le même problème dans mon PDF joint à mon mail :(
Sub Envoi_Checkpoint_CR_ToPDF_ToMail()
' Déclarationd es variables utilisées dans le code
Dim sPath As String, sFileName As String, ShtName As String
Dim OutObj As Object, Email As Object
DateCP = Range("DateCP").Value
ComiteCP = Range("ComiteCP").Value
NumeroCP = Range("NumeroCP").Value
' masquer les deux premières lignes et masquer la deuxième partie si pas de contenu
With activesheets
'Columns("A:A").EntireColumn.Hidden = True
Rows("1:2").EntireRow.Hidden = True
If Range("J13") = "" Then
Columns("I:M").EntireColumn.Hidden = True
End If
' Initialisation des variables
' Chemin d'accès du dossier TEMP
sPath = Environ("TEMP") & "\"
' Nom du fichier à envoyer par mail
sFileName = "[" & Range("NomProjet").Value & "]" & " " & "CR Checkpoint" & " " & Range("J4").Value & ComiteCP & NumeroCP & ".pdf"
' Vérifier l'extension du fichier à enregistrer
If Right(sFileName, 4) <> ".pdf" Then sFileName = sFileName & ".pdf"
' Nom de la feuille à exporter en PDF
ShtName = ActiveSheet.Name
'
Range("B13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("c13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("D13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("E13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("F13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("I13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("J13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
Range("K13").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(1, 0).Activate
End If
Loop
' 1) Générer le PDF dans le répertoir temporaire de l'utilisateur
Sheets(ShtName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sFileName, _
Quality:=xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, openafterpublish:=False
'Columns("A:A").EntireColumn.Hidden = False
Rows("1:2").EntireRow.Hidden = False
Columns("I:M").EntireColumn.Hidden = False
'
' 2) Créer le mail et joindre le fichier
' Création d'une instance Outlook pour envoyer un mail
Set OutObj = CreateObject("Outlook.Application")
Set Email = OutObj.CreateItem(0)
' Avec mon objet Email
With Email
.Display ' Afficher le mail pour afficher la signature
' Destinataire(s) du mail
.To = Range("Dest1CP").Value & ";" & Range("Dest2CP").Value & ";" & Range("Dest3CP").Value & ";" & Range("Dest4CP").Value & ";" & Range("Dest5CP").Value & ";" & Range("Dest6CP").Value & ";" & Range("Dest7CP").Value & ";" & Range("Dest8CP").Value
' Copie du mail
.CC = Range("Cc1CP").Value & ";" & Range("Cc2CP").Value & ";" & Range("Cc3CP").Value & ";" & Range("Cc4CP").Value
' Sujet de l'eMail°
.Subject = "[" & Range("NomProjet").Value & "]" & " " & "CR Checkpoint" & " " & Range("J4").Value & ComiteCP & NumeroCP
' Corps du mail avec signature à la fin
.Body = "Bonjour," & vbNewLine & _
vbNewLine & _
"Veuillez trouver ci-joint le compte rendu de notre dernier checkpoint." & vbNewLine & _
vbNewLine & _
"Bien à vous,"
' Joindre le fichier précédemment créé
.Attachments.Add sPath & sFileName
' Envoyer l'email
'.Send
End With
' Effacer les variable objet
Set Email = Nothing: Set OutObj = Nothing
' Supprimer le fichier du répertoire temporaire
Kill sPath & sFileName
'Sheets("Checkpoint_CR").Select
End With
End SubM
Je précise que sur Excel toutes ces bordures sont biens en place et visibles avant toute procédure d'édition
M
Le voici
Edit modo : fichier avec VBA project protégé = supprimé
M
Oui désolé je viens de men apercevoir, j'envoi à nouveau
M
Invité
Re,
Et bien du coup je comprends mieux
1) Vous ne définissez pas votre zone d'impression
2) la colonne G conjointe à votre tableau est masquée
Donc tout cela favorise votre problème, sinon, voici ce que l'on obtient
A+
M
Bruno merci pour la réponse
Concernant la zone d'impression, en effet je ne l'ai pas défini car je ne parvenais pas à la définir étant donné que le nombre de ligne vers le bas est changeant d'un checkpoint à l'autre.
Question: Auriez vous une piste pour moi afin de rendre la zone d'impression dynamique ? Cela résoudrait pas mal de mes problèmes en effet, actuels et à venir ;)
Mon sujet ici serait aussi résolu par la même occaz :)
Merci beaucoup
PS: sélectionner la plage à éditer, en vba, et la nommer "Zone_d_impression" peut-il fonctionner ? Et retirer le nom après l'impression ou le changer lors de la prochaine
M
Juste pour signaler que j'ai trouvé la solution à mon problème ici
J'ai juste adapter mon code
Sub Btn_Aperçu_Impression_Universel()
'attention la zone d'impression s'arrêtera aux premières cellules vides
Dim DerLig As Integer, DerCol As Integer
With ActiveSheet
DerLig = .Range("B" & Rows.Count).End(xlUp).Row 'mettre la colonne contenant le MAXIMUM de ligne de la zone d'impression
DerCol = .Cells(12, Columns.Count).End(xlToLeft).Column 'mettre la ligne contenant le MAXIMUM de colonne de la zone d'impression
.PageSetup.PrintArea = .Range(.Cells(3, 1).Address & ":" & .Cells(DerLig, DerCol).Address).Address 'je voulais que ça démarre à B1:...
End With
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
Columns("I:M").EntireColumn.Hidden = False
End SubInvité
Re,
Nota : il y a pas d'optimisation à faire dans le fichier déposé, mais si le problème est réglé tant mieux
M
Bonjour,
Autant pour moi !
je viens de réessayer avec les solutions que je me suis construite mais rien n'y fait, certaines bordures sont toujours absentes :'(
Pourtant j'ai bien une zone d'impression défini et aucune colonne n'est masqué....
M
Ok c'est bon j'ai trouvé....
La largeur de la colonne voisine était très étroite. Je l'ai agrandi et plus de soucis...
Du coup, même plus besoin de zone d'impression, mais j'ai appris des choses pour la suite c'est le plus important =D
Merci des conseils