Problème Select

[FoLKeN]

Bonjour à tous,

J'ai un petit souci lorsque je veux copier une certaine partie d'une feuille dans un autre classeur en VBA. Voici mon code (il y a plein de trucs inintéressants, j'ai marqué la ligne qui bug). Accessoirement, j'ai aussi un autre souci: je voudrais mettre par défaut le zoom du nouveau classeur à 80 mais ca ne marche pas.

Sub CreatePlanningOutput()

    ' Declaration
    Dim saveName As String
    Dim savePath As String
    savePath = Application.ThisWorkbook.Path & "\Outputs\Compact_Training_Plans\"
    Dim prefixSaveName As String
    prefixSaveName = "Compact Training Plan - "
    Dim suffixSaveName As String
    suffixSaveName = ".xls"
    Dim CurrentRange As Range
    
    ' Loop declaration
    Dim LoopSheet As Worksheet
    
    ' Open an excel workbook
    Dim NewWkb As Workbook
    Set NewWkb = Application.Workbooks.Add
    
    ' In case there is an error
    On Error GoTo ErrQuit
    
    ' Link to the original workbook sheets
    Dim TrainingSheet As Worksheet
    Dim SessionsSheet As Worksheet
    Dim VirtualSheet As Worksheet
    Dim TraineePlanningSheet As Worksheet
    
    Set TrainingSheet = ThisWorkbook.Sheets("Training_Map")
    Set SessionsSheet = ThisWorkbook.Sheets("Sessions_Details")
    Set VirtualSheet = ThisWorkbook.Sheets("Virtual_Sessions")
    Set TraineePlanningSheet = ThisWorkbook.Sheets("Trainees_Full_Planning")
    
    ' Allocate the new workbook sheets
    Dim NewTrainingSheet As Worksheet
    Dim NewSessionsSheet As Worksheet
    Dim NewVirtualSheet As Worksheet
    Dim NewTraineePlanningSheet As Worksheet
    
    Set NewTrainingSheet = NewWkb.Sheets(1)
    NewTrainingSheet.Name = TrainingSheet.Name
    
    Set NewSessionsSheet = NewWkb.Sheets(2)
    NewSessionsSheet.Name = SessionsSheet.Name
    
    Set NewVirtualSheet = NewWkb.Sheets(3)
    NewVirtualSheet.Name = VirtualSheet.Name
    
    Set NewTraineePlanningSheet = NewWkb.Sheets.Add
    NewTraineePlanningSheet.Name = TraineePlanningSheet.Name
    
    ' Put the zoom to 80% and remove cell outlines
    For Each LoopSheet In NewWkb.Sheets
        [COLOR="Red"]LoopSheet.PageSetup.Zoom = 80 ' DOESNT WORK[/COLOR]
        LoopSheet.Cells.Interior.PatternColorIndex = xlAutomatic
    Next LoopSheet
    
    ' Copy the Training_Map table
    [COLOR="Red"]TrainingSheet.Range("B8:GW1413").Select 'PB ICI[/COLOR]
    Selection.Copy
    Set CurrentRange = NewTrainingSheet.Range("B2")
    NewTrainingSheet.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    NewTrainingSheet.Range("B2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    NewTrainingSheet.Range("B2").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    ' Copy the sessions_details table
    
    ' Copy the virtual session table (if not empty)
    
    ' Copy the Trainee_Full_Planning table
    
    ' Copy the Instructor_Full_Planning table (?)
    
    ' Create the saving name
    Dim CurrentDate As String
    Dim CurrentTime As String
    CurrentDate = CStr(Format(Now, "DD.MM.YY", vbMonday))
    CurrentTime = CStr(Format(Now, "HH.MM", vbMonday))
    saveName = prefixSaveName & CurrentDate & " at " & CurrentTime & suffixSaveName
    If CreateFolder(savePath) Then MsgBox ("Saving in: " & savePath & saveName)
    
ErrQuit:
    ' Save & quit
    If Err.Number = 0 Then
        NewWkb.SaveAs FileName:=savePath & saveName
        NewWkb.Close
        MsgBox ("Document Created")
    Else
        NewWkb.Close SaveChanges:=False
        MsgBox ("Error while creating the document: " & Err.Description)
    End If
    
    Set NewWkb = Nothing
    
End Sub

Merci de me dire ce qui ne va pas 🙂
FoLKeN

 

[PascalXLD]

Re : Problème Select

Bonjour

Vite fait sans tester pour ton pbe de select

essaies

TrainingSheet.Select
Range("B8:GW1413").Select

Bien sûr tu es en version 2007 car la colonne GW ......

 

[dixit]

Re : Problème Select

bonjour,
pour la sélection de plage, il me semble que la feuille doit être active.

 

[FoLKeN]

Re : Problème Select

Bonjour à vous,

J'avais déjà essayé vos deux solutions mais ca ne marchait pas. En revanche j'ai fait un mix des deux, à savoir:
TrainingSheet.Activate
Range("B8:GW1413").Select

Et ca marche ! 🙂 Merci. Sinon non c'est Excel 2002, (GW < 255)

Vous n'avez pas d'idée pour mon problème de zoom ?

Sinon vous savez comment faire une copie spéciale avec le format, mais sans le format conditionnel. Par exemple la cellule d'origine est blanche, devient verte à cause du format conditionnel, et je voudrais que la cellule copiée soit juste verte, mais sans avoir le format conditionnel.

Merci encore en tout cas

 

[PascalXLD]

Re : Problème Select

Et ca marche ! 🙂 Merci. Sinon non c'est Excel 2002, (GW < 255)

Oh là en effet il est temps que le WE arrive je suis fatigué moi !!!