Salut le forum,
je susi bientot en vacance donc je pense ne plus evous embeter pendant 1 mois.
et je tiens a vous remercier encore tous autant que vous etes pour vos aides.
Je reviens aujourd'hui vers vous avec une macro réaliser seul avec quelques infos de different site mais aussi de l'enregistreur de macro.
Je souhaiterais integrer une barre de progression sur ma macro, j'ai déja retourner dans tous les sens les differents topics de plusieurs forum.
je ne comprend pas comment l'integrer dans ma macro.
faut dire que je suis une bille en vba
Si kk1 peut me donner un coup de main
voici la macro
Sub VAD()
' *********************************************************************************************
'Ouvrir les fichiers excel
'**********************************************************************************************
Application.ScreenUpdating = False ' désactive l'affichage d'écran
Workbooks.Open Filename:= _
"\\x", UpdateLinks:=0
Sheets("Coffrets").Select
Workbooks.Open Filename:= _
"\\x", UpdateLinks:=0
Sheets("Prix").Select
'**********************************************************************************************
' copie colle les donneés sur la matrice
'**********************************************************************************************
Windows("Communication PVC.xls").Activate
Sheets("Coffrets").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Windows("Matrice mise à jours prix catalogue.xls").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
ActiveSheet.Paste
'********************************************************************************************
' Copie et colle la colonne des terminaux
'********************************************************************************************
Windows("Matrice mise à jours prix catalogue.xls").Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
Application.CutCopyMode = False
Selection.FillDown
Columns("A:A").Select
Selection.Copy
Columns("E:E").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("z").Select
'******************************************************************************************
'Ouvrir le fichier powerpoint pour insertion
'Necessite d'activer la reference Microsoft Powerpoint Object Library
'******************************************************************************************
Dim PPT As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim NbShpe As Byte
Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint
PPT.Visible = True 'l'application sera visible
Set PptDoc = PPT.Presentations.Open("\\x")
'**********************************************************************************************
'copie et colle vers ppt
'**********************************************************************************************
Sheets("z").Select
Range("A1:k8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(2).Shapes.Paste
'**********************************************************************************************
'compte le nombre de shapes dans le 3eme slide
'le dernier objet inséré correspond à l'index le plus élevé
'**************************************************************************************************
NbShpe = PptDoc.Slides(2).Shapes.Count
With PptDoc.Slides(2).Shapes(NbShpe)
.Name = "z1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("z").Select
Range("A9:k16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(3).Shapes.Paste
NbShpe = PptDoc.Slides(3).Shapes.Count
With PptDoc.Slides(3).Shapes(NbShpe)
.Name = "z" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("m").Select
Range("A1:k8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(4).Shapes.Paste
NbShpe = PptDoc.Slides(4).Shapes.Count
With PptDoc.Slides(4).Shapes(NbShpe)
.Name = "m1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("m").Select
Range("A9:k16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(5).Shapes.Paste
NbShpe = PptDoc.Slides(5).Shapes.Count
With PptDoc.Slides(5).Shapes(NbShpe)
.Name = "m2" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("c").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(6).Shapes.Paste
NbShpe = PptDoc.Slides(6).Shapes.Count
With PptDoc.Slides(6).Shapes(NbShpe)
.Name = "c1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 200 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("c").Select
Range("A9:m17").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(7).Shapes.Paste
NbShpe = PptDoc.Slides(7).Shapes.Count
With PptDoc.Slides(7).Shapes(NbShpe)
.Name = "c" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("p").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(8).Shapes.Paste
NbShpe = PptDoc.Slides(8).Shapes.Count
With PptDoc.Slides(8).Shapes(NbShpe)
.Name = "p" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("p").Select
Range("A9:m16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(9).Shapes.Paste
NbShpe = PptDoc.Slides(9).Shapes.Count
With PptDoc.Slides(9).Shapes(NbShpe)
.Name = "p" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("i").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(10).Shapes.Paste
NbShpe = PptDoc.Slides(10).Shapes.Count
With PptDoc.Slides(10).Shapes(NbShpe)
.Name = "i" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("i").Select
Range("A9:m16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(11).Shapes.Paste
NbShpe = PptDoc.Slides(11).Shapes.Count
With PptDoc.Slides(11).Shapes(NbShpe)
.Name = "i" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
PptDoc.SaveAs Filename:="\\x.ppt"
Windows("Matrice mise à jours prix catalogue.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows("Communication PVC.xls").Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
Application.ScreenUpdating = True ' active l'affichage d'écran
MsgBox "Traitement terminé", vbInformation
End Sub
Merci
je susi bientot en vacance donc je pense ne plus evous embeter pendant 1 mois.
et je tiens a vous remercier encore tous autant que vous etes pour vos aides.
Je reviens aujourd'hui vers vous avec une macro réaliser seul avec quelques infos de different site mais aussi de l'enregistreur de macro.
Je souhaiterais integrer une barre de progression sur ma macro, j'ai déja retourner dans tous les sens les differents topics de plusieurs forum.
je ne comprend pas comment l'integrer dans ma macro.
faut dire que je suis une bille en vba
Si kk1 peut me donner un coup de main
voici la macro
Sub VAD()
' *********************************************************************************************
'Ouvrir les fichiers excel
'**********************************************************************************************
Application.ScreenUpdating = False ' désactive l'affichage d'écran
Workbooks.Open Filename:= _
"\\x", UpdateLinks:=0
Sheets("Coffrets").Select
Workbooks.Open Filename:= _
"\\x", UpdateLinks:=0
Sheets("Prix").Select
'**********************************************************************************************
' copie colle les donneés sur la matrice
'**********************************************************************************************
Windows("Communication PVC.xls").Activate
Sheets("Coffrets").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Windows("Matrice mise à jours prix catalogue.xls").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
ActiveSheet.Paste
'********************************************************************************************
' Copie et colle la colonne des terminaux
'********************************************************************************************
Windows("Matrice mise à jours prix catalogue.xls").Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
Application.CutCopyMode = False
Selection.FillDown
Columns("A:A").Select
Selection.Copy
Columns("E:E").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("z").Select
'******************************************************************************************
'Ouvrir le fichier powerpoint pour insertion
'Necessite d'activer la reference Microsoft Powerpoint Object Library
'******************************************************************************************
Dim PPT As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim NbShpe As Byte
Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint
PPT.Visible = True 'l'application sera visible
Set PptDoc = PPT.Presentations.Open("\\x")
'**********************************************************************************************
'copie et colle vers ppt
'**********************************************************************************************
Sheets("z").Select
Range("A1:k8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(2).Shapes.Paste
'**********************************************************************************************
'compte le nombre de shapes dans le 3eme slide
'le dernier objet inséré correspond à l'index le plus élevé
'**************************************************************************************************
NbShpe = PptDoc.Slides(2).Shapes.Count
With PptDoc.Slides(2).Shapes(NbShpe)
.Name = "z1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("z").Select
Range("A9:k16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(3).Shapes.Paste
NbShpe = PptDoc.Slides(3).Shapes.Count
With PptDoc.Slides(3).Shapes(NbShpe)
.Name = "z" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("m").Select
Range("A1:k8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(4).Shapes.Paste
NbShpe = PptDoc.Slides(4).Shapes.Count
With PptDoc.Slides(4).Shapes(NbShpe)
.Name = "m1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("m").Select
Range("A9:k16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(5).Shapes.Paste
NbShpe = PptDoc.Slides(5).Shapes.Count
With PptDoc.Slides(5).Shapes(NbShpe)
.Name = "m2" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("c").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(6).Shapes.Paste
NbShpe = PptDoc.Slides(6).Shapes.Count
With PptDoc.Slides(6).Shapes(NbShpe)
.Name = "c1" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 200 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("c").Select
Range("A9:m17").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(7).Shapes.Paste
NbShpe = PptDoc.Slides(7).Shapes.Count
With PptDoc.Slides(7).Shapes(NbShpe)
.Name = "c" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("p").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(8).Shapes.Paste
NbShpe = PptDoc.Slides(8).Shapes.Count
With PptDoc.Slides(8).Shapes(NbShpe)
.Name = "p" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("p").Select
Range("A9:m16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(9).Shapes.Paste
NbShpe = PptDoc.Slides(9).Shapes.Count
With PptDoc.Slides(9).Shapes(NbShpe)
.Name = "p" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
Sheets("i").Select
Range("A1:M8").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(10).Shapes.Paste
NbShpe = PptDoc.Slides(10).Shapes.Count
With PptDoc.Slides(10).Shapes(NbShpe)
.Name = "i" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 230 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 730 'largeur image
End With
Sheets("i").Select
Range("A9:m16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
PptDoc.Slides(11).Shapes.Paste
NbShpe = PptDoc.Slides(11).Shapes.Count
With PptDoc.Slides(11).Shapes(NbShpe)
.Name = "i" 'personnaliser le nom de l'image insérée
.Left = 5 'position horizontale dans le slide
.Top = 100 'position verticale dans le slide
.Height = 100 'hauteur image
.Width = 700 'largeur image
End With
PptDoc.SaveAs Filename:="\\x.ppt"
Windows("Matrice mise à jours prix catalogue.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows("Communication PVC.xls").Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
Application.ScreenUpdating = True ' active l'affichage d'écran
MsgBox "Traitement terminé", vbInformation
End Sub
Merci
