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
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
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
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é ?
PinsonBonjour,
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
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
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é ?
PinsonBonjour,
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
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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
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" <pinson372@discussions.microsoft.com> a écrit dans le message
de
news:A070AFDC-C23B-4504-9C33-40C321E5C8B0@microsoft.com...
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
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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
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
tudevrais 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
denews:Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème,
oualors mon problème est il mal enoncé ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
Bonjour,
Ach, impression gross malheurr
--
à+Von Twinlerr
"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le message
de news:e7VpkwmtEHA.3292@TK2MSFTNGP12.phx.gbl...
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" <pinson372@discussions.microsoft.com> a écrit dans le message
de
news:A070AFDC-C23B-4504-9C33-40C321E5C8B0@microsoft.com...
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
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
tudevrais 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
denews:Bonjour,
n'y a t il personne pour m'aider à trouver la solution à mon problème,
oualors mon problème est il mal enoncé ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
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" <pinson372@discussions.microsoft.com> a écrit dans le message de
news:A070AFDC-C23B-4504-9C33-40C321E5C8B0@microsoft.com...
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
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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une page
maisde 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
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...
Pinsonbonjour 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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une
page
maisde 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
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" <pinson372@discussions.microsoft.com> a écrit dans le
message de
news:A070AFDC-C23B-4504-9C33-40C321E5C8B0@microsoft.com...
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
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...
Pinsonbonjour 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é ?
PinsonBonjour,
voilà mon problème,
j'ai 20 lignes et 50 colonnes,j'aimerais imprimer le tout sur une
page
maisde 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