Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

impression lignes colonnes

6 réponses
Avatar
pinson372
Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page mais
de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier tableau,
car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson

6 réponses

Avatar
pinson372
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème, ou
alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page mais
de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier tableau,
car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson


Avatar
sabatier
bonjour pinson372
l'incontournable frédéric sigonneau a pondu, en son temps, cette proc que tu
devrais essayer pour voir si elle fait bien ce que tu cherches à faire...
même si j'ai beaucoup collaboré à son élaboration (les mots allemands sont
de moi, par exemple...), ne me demande pas de l'adapter...
HTH
jps

Sub testImpr()
alerte = MsgBox("avez-vous bien au moins une feuille vide dans ce
classeur", _
vbYesNo, "ACHTUNG MINEN GEFAHR")
If alerte = vbNo Then Exit Sub
On Error GoTo Fin
nFeuille = InputBox("Feuille à traiter :")
nCell = InputBox _
("Notez une cellule de la colonne à découper (ex A1) :")
nCol = InputBox("Nb de colonnes dans la présentation :")
nLi = InputBox("Nb de lignes par pages après découpage :")
ImprimeEnColonnes nFeuille, Range(nCell), nCol, nLi, True
Fin:
Exit Sub
End Sub
Sub ImprimeEnColonnes(ByVal NomFeuille As String, _
Source As Range, _
ByVal nbcol As Byte, _
ByVal nbLi As Byte, _
ByVal Aperçu As String)
Dim ShSrc As Worksheet, ShTmp As Worksheet
Set ShSrc = ActiveWorkbook.Worksheets(NomFeuille)
Application.ScreenUpdating = False
Set ShTmp = ActiveWorkbook.Worksheets.Add
' Set ShTmp = ActiveWorkbook.Worksheets(Worksheets.Count)
On Error GoTo Fin
derli = Source.End(xlDown).Row
colSrc = Source.Column
ShSrc.Activate
ShSrc.Range(Cells(1, colSrc), Cells(derli, colSrc)).Select
Selection.Copy
ShTmp.Activate
ShTmp.Range("A1").PasteSpecial xlPasteAll
With ActiveSheet
x = 1
For i = 1 To derli
For y = 2 To nbcol + 1
.Range(Cells(i, 1), Cells(i + nbLi - 1, 1)).Select
Selection.Copy
.Cells(x, y).PasteSpecial xlPasteAll
i = i + nbLi
Next y
x = x + nbLi
i = i - 1
Next i
.Columns(1).Delete
.UsedRange.Columns.AutoFit
For i = nbLi To .UsedRange.End(xlDown).Row Step nbLi
.HPageBreaks.Add Before:=.Range("A" & i + 1)
Next i
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Application.DisplayAlerts = False
ShTmp.Delete
Application.DisplayAlerts = True
ShSrc.Activate
[A1].Select
Fin:
Application.ScreenUpdating = True
End Sub
"pinson372" a écrit dans le message de
news:
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème, ou
alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
mais


de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier
tableau,


car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson




Avatar
twinley
Bonjour,

Ach, impression gross malheurr

--
à+Von Twinlerr
"sabatier" a écrit dans le message
de news:
bonjour pinson372
l'incontournable frédéric sigonneau a pondu, en son temps, cette proc que
tu

devrais essayer pour voir si elle fait bien ce que tu cherches à faire...
même si j'ai beaucoup collaboré à son élaboration (les mots allemands sont
de moi, par exemple...), ne me demande pas de l'adapter...
HTH
jps

Sub testImpr()
alerte = MsgBox("avez-vous bien au moins une feuille vide dans ce
classeur", _
vbYesNo, "ACHTUNG MINEN GEFAHR")
If alerte = vbNo Then Exit Sub
On Error GoTo Fin
nFeuille = InputBox("Feuille à traiter :")
nCell = InputBox _
("Notez une cellule de la colonne à découper (ex A1) :")
nCol = InputBox("Nb de colonnes dans la présentation :")
nLi = InputBox("Nb de lignes par pages après découpage :")
ImprimeEnColonnes nFeuille, Range(nCell), nCol, nLi, True
Fin:
Exit Sub
End Sub
Sub ImprimeEnColonnes(ByVal NomFeuille As String, _
Source As Range, _
ByVal nbcol As Byte, _
ByVal nbLi As Byte, _
ByVal Aperçu As String)
Dim ShSrc As Worksheet, ShTmp As Worksheet
Set ShSrc = ActiveWorkbook.Worksheets(NomFeuille)
Application.ScreenUpdating = False
Set ShTmp = ActiveWorkbook.Worksheets.Add
' Set ShTmp = ActiveWorkbook.Worksheets(Worksheets.Count)
On Error GoTo Fin
derli = Source.End(xlDown).Row
colSrc = Source.Column
ShSrc.Activate
ShSrc.Range(Cells(1, colSrc), Cells(derli, colSrc)).Select
Selection.Copy
ShTmp.Activate
ShTmp.Range("A1").PasteSpecial xlPasteAll
With ActiveSheet
x = 1
For i = 1 To derli
For y = 2 To nbcol + 1
.Range(Cells(i, 1), Cells(i + nbLi - 1, 1)).Select
Selection.Copy
.Cells(x, y).PasteSpecial xlPasteAll
i = i + nbLi
Next y
x = x + nbLi
i = i - 1
Next i
.Columns(1).Delete
.UsedRange.Columns.AutoFit
For i = nbLi To .UsedRange.End(xlDown).Row Step nbLi
.HPageBreaks.Add Before:=.Range("A" & i + 1)
Next i
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Application.DisplayAlerts = False
ShTmp.Delete
Application.DisplayAlerts = True
ShSrc.Activate
[A1].Select
Fin:
Application.ScreenUpdating = True
End Sub
"pinson372" a écrit dans le message
de

news:
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème,
ou


alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
mais


de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier
tableau,


car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson








Avatar
pinson372
MERCI pour votre aide
je vais tester
et ne manquerais pas de vous informer du résultat
Pinson


Bonjour,

Ach, impression gross malheurr

--
à+Von Twinlerr
"sabatier" a écrit dans le message
de news:
bonjour pinson372
l'incontournable frédéric sigonneau a pondu, en son temps, cette proc que
tu

devrais essayer pour voir si elle fait bien ce que tu cherches à faire...
même si j'ai beaucoup collaboré à son élaboration (les mots allemands sont
de moi, par exemple...), ne me demande pas de l'adapter...
HTH
jps

Sub testImpr()
alerte = MsgBox("avez-vous bien au moins une feuille vide dans ce
classeur", _
vbYesNo, "ACHTUNG MINEN GEFAHR")
If alerte = vbNo Then Exit Sub
On Error GoTo Fin
nFeuille = InputBox("Feuille à traiter :")
nCell = InputBox _
("Notez une cellule de la colonne à découper (ex A1) :")
nCol = InputBox("Nb de colonnes dans la présentation :")
nLi = InputBox("Nb de lignes par pages après découpage :")
ImprimeEnColonnes nFeuille, Range(nCell), nCol, nLi, True
Fin:
Exit Sub
End Sub
Sub ImprimeEnColonnes(ByVal NomFeuille As String, _
Source As Range, _
ByVal nbcol As Byte, _
ByVal nbLi As Byte, _
ByVal Aperçu As String)
Dim ShSrc As Worksheet, ShTmp As Worksheet
Set ShSrc = ActiveWorkbook.Worksheets(NomFeuille)
Application.ScreenUpdating = False
Set ShTmp = ActiveWorkbook.Worksheets.Add
' Set ShTmp = ActiveWorkbook.Worksheets(Worksheets.Count)
On Error GoTo Fin
derli = Source.End(xlDown).Row
colSrc = Source.Column
ShSrc.Activate
ShSrc.Range(Cells(1, colSrc), Cells(derli, colSrc)).Select
Selection.Copy
ShTmp.Activate
ShTmp.Range("A1").PasteSpecial xlPasteAll
With ActiveSheet
x = 1
For i = 1 To derli
For y = 2 To nbcol + 1
.Range(Cells(i, 1), Cells(i + nbLi - 1, 1)).Select
Selection.Copy
.Cells(x, y).PasteSpecial xlPasteAll
i = i + nbLi
Next y
x = x + nbLi
i = i - 1
Next i
.Columns(1).Delete
.UsedRange.Columns.AutoFit
For i = nbLi To .UsedRange.End(xlDown).Row Step nbLi
.HPageBreaks.Add Before:=.Range("A" & i + 1)
Next i
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Application.DisplayAlerts = False
ShTmp.Delete
Application.DisplayAlerts = True
ShSrc.Activate
[A1].Select
Fin:
Application.ScreenUpdating = True
End Sub
"pinson372" a écrit dans le message
de

news:
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème,
ou


alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
mais


de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier
tableau,


car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson













Avatar
pinson372
je rencontre quelques problèmes avec cette procédure...
si je comprends bien, il y a un copier coller,
j'ai des problèmes de references et je n'arrive pas à avoir le resultat
escompté
le nombre de ligne s est correctes, mais pas les colonnes, et comme dit ci
dessus, problème de références...
Pinson


bonjour pinson372
l'incontournable frédéric sigonneau a pondu, en son temps, cette proc que tu
devrais essayer pour voir si elle fait bien ce que tu cherches à faire...
même si j'ai beaucoup collaboré à son élaboration (les mots allemands sont
de moi, par exemple...), ne me demande pas de l'adapter...
HTH
jps

Sub testImpr()
alerte = MsgBox("avez-vous bien au moins une feuille vide dans ce
classeur", _
vbYesNo, "ACHTUNG MINEN GEFAHR")
If alerte = vbNo Then Exit Sub
On Error GoTo Fin
nFeuille = InputBox("Feuille à traiter :")
nCell = InputBox _
("Notez une cellule de la colonne à découper (ex A1) :")
nCol = InputBox("Nb de colonnes dans la présentation :")
nLi = InputBox("Nb de lignes par pages après découpage :")
ImprimeEnColonnes nFeuille, Range(nCell), nCol, nLi, True
Fin:
Exit Sub
End Sub
Sub ImprimeEnColonnes(ByVal NomFeuille As String, _
Source As Range, _
ByVal nbcol As Byte, _
ByVal nbLi As Byte, _
ByVal Aperçu As String)
Dim ShSrc As Worksheet, ShTmp As Worksheet
Set ShSrc = ActiveWorkbook.Worksheets(NomFeuille)
Application.ScreenUpdating = False
Set ShTmp = ActiveWorkbook.Worksheets.Add
' Set ShTmp = ActiveWorkbook.Worksheets(Worksheets.Count)
On Error GoTo Fin
derli = Source.End(xlDown).Row
colSrc = Source.Column
ShSrc.Activate
ShSrc.Range(Cells(1, colSrc), Cells(derli, colSrc)).Select
Selection.Copy
ShTmp.Activate
ShTmp.Range("A1").PasteSpecial xlPasteAll
With ActiveSheet
x = 1
For i = 1 To derli
For y = 2 To nbcol + 1
.Range(Cells(i, 1), Cells(i + nbLi - 1, 1)).Select
Selection.Copy
.Cells(x, y).PasteSpecial xlPasteAll
i = i + nbLi
Next y
x = x + nbLi
i = i - 1
Next i
.Columns(1).Delete
.UsedRange.Columns.AutoFit
For i = nbLi To .UsedRange.End(xlDown).Row Step nbLi
.HPageBreaks.Add Before:=.Range("A" & i + 1)
Next i
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Application.DisplayAlerts = False
ShTmp.Delete
Application.DisplayAlerts = True
ShSrc.Activate
[A1].Select
Fin:
Application.ScreenUpdating = True
End Sub
"pinson372" a écrit dans le message de
news:
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème, ou
alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
mais


de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier
tableau,


car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson









Avatar
sabatier
j'espère que FS comprendra ce que veut dire un "problème de
références"...moi, comme déjà dit, je me retire, non sans te préciser,
pinson372, qu'il faut, je pense, tester plusieurs fois cette proc pour
arriver à ses fins...
plus qu'à espérer que FS jette un oeil attendri sur cette ficelle
jps

"pinson372" a écrit dans le message
de news:
je rencontre quelques problèmes avec cette procédure...
si je comprends bien, il y a un copier coller,
j'ai des problèmes de references et je n'arrive pas à avoir le resultat
escompté
le nombre de ligne s est correctes, mais pas les colonnes, et comme dit ci
dessus, problème de références...
Pinson


bonjour pinson372
l'incontournable frédéric sigonneau a pondu, en son temps, cette proc
que tu


devrais essayer pour voir si elle fait bien ce que tu cherches à
faire...


même si j'ai beaucoup collaboré à son élaboration (les mots allemands
sont


de moi, par exemple...), ne me demande pas de l'adapter...
HTH
jps

Sub testImpr()
alerte = MsgBox("avez-vous bien au moins une feuille vide dans ce
classeur", _
vbYesNo, "ACHTUNG MINEN GEFAHR")
If alerte = vbNo Then Exit Sub
On Error GoTo Fin
nFeuille = InputBox("Feuille à traiter :")
nCell = InputBox _
("Notez une cellule de la colonne à découper (ex A1) :")
nCol = InputBox("Nb de colonnes dans la présentation :")
nLi = InputBox("Nb de lignes par pages après découpage :")
ImprimeEnColonnes nFeuille, Range(nCell), nCol, nLi, True
Fin:
Exit Sub
End Sub
Sub ImprimeEnColonnes(ByVal NomFeuille As String, _
Source As Range, _
ByVal nbcol As Byte, _
ByVal nbLi As Byte, _
ByVal Aperçu As String)
Dim ShSrc As Worksheet, ShTmp As Worksheet
Set ShSrc = ActiveWorkbook.Worksheets(NomFeuille)
Application.ScreenUpdating = False
Set ShTmp = ActiveWorkbook.Worksheets.Add
' Set ShTmp = ActiveWorkbook.Worksheets(Worksheets.Count)
On Error GoTo Fin
derli = Source.End(xlDown).Row
colSrc = Source.Column
ShSrc.Activate
ShSrc.Range(Cells(1, colSrc), Cells(derli, colSrc)).Select
Selection.Copy
ShTmp.Activate
ShTmp.Range("A1").PasteSpecial xlPasteAll
With ActiveSheet
x = 1
For i = 1 To derli
For y = 2 To nbcol + 1
.Range(Cells(i, 1), Cells(i + nbLi - 1, 1)).Select
Selection.Copy
.Cells(x, y).PasteSpecial xlPasteAll
i = i + nbLi
Next y
x = x + nbLi
i = i - 1
Next i
.Columns(1).Delete
.UsedRange.Columns.AutoFit
For i = nbLi To .UsedRange.End(xlDown).Row Step nbLi
.HPageBreaks.Add Before:=.Range("A" & i + 1)
Next i
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Application.DisplayAlerts = False
ShTmp.Delete
Application.DisplayAlerts = True
ShSrc.Activate
[A1].Select
Fin:
Application.ScreenUpdating = True
End Sub
"pinson372" a écrit dans le
message de


news:
Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème,
ou



alors mon problème est il mal enoncé ?
Pinson


Bonjour,

voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une
page




mais
de la manière suivante :
20 lignes 30 colonnes et EN DESSOUS
repeter les deux permières colonnes avec les 30 autres derrières.
J'ai bien réussi à faire cette opération mais sur 2 pages.
Et moi, j'aimerais que l'impression continue en dessous du premier
tableau,


car il y a encore suffisamment de place.
Merci pour votre aide.
Pinson