VBA macro

[nighthawk]

Bonjour,

je suis novice en VBA...
j'ai essayé de faire une fonction qui automatisé certaines fonctions
en essayant de la faire en ayant trouvé des exmples sur le net.

( A la base je veux :

A l’ouverture d’une feuille Excel :
L’utilisateur sélectionne des feuilles dans le fichier ouvert :
La macro doit Pouvoir réaliser, dans ces feuilles sélectionné un copier coller
- Des valeurs (seulement)
- Des formats des feuilles
- Si possible des photos éventuels

Et sauvegarder ça dans un autre fichier.
)

Mais j'ai quelque soucis :

1 : la partie
<code>For Each feuille In Selection.Sheets</code>
j'ai une erreur sur feuille = >' Erreur d’exécution ‘438’
Propriété ou méthode non géré par cet objet. ' pb sur mot feuille

je sais pas comment lui dire que c la ou les feuille(s) sélectionné du classeur qu'il faut qu'il prenne en compte.

2 : je ne sais pas comment faut il lui indiquer qu'il faut qu'il garde la mise en page d'origine.

3 : comment pouvoir également copier les images du document?

Sub cut_paste()

Application.ScreenUpdating = False 'désactive la mise à jour de l'écran (accélère l'application)

'For Each feuille In Selection.Sheets
' feuille.Activate

Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ChDir 'D:\\Download'

'Next feuille


ActiveWorkbook.SaveAs Filename:='D:\\Download\\Classeur1.xls', FileFormat:= _
xlNormal, Password:='', WriteResPassword:='', ReadOnlyRecommended:=False _
, CreateBackup:=False

Application.ScreenUpdating = True 'désactive la mise à jour de l'écran (accélère l'application)

End Sub

merci de votre aide!

 

[nighthawk]

ehuuu meme pas une idée?

ou un endroit ou je pourrais trouver toutes les fonctions utilisable en VBA?
mon aide sous excel est unitilisable.
merci

 

[myDearFriend!]

Bonjour nighthawk, le Forum.

Peut-être pourrais-tu essayer tout simplement ça :

Sub SauvSelectFeuilles()
      Windows(1).SelectedSheets.Copy
      Application.Dialogs(xlDialogSaveAs).Show 'NouveauClasseur'
      ActiveWorkbook.Close False
End Sub

Cordialement

 

[nighthawk]

re , je sais pas si mon message a été posté ou pas
dc je le remet :

j'ai bien utilisé ton bout de code mais j'ai une erreur

Erreur d’exécution ‘-2147417848’
La methode ‘show’ de l’objet a échoué


j'aurais 2 questions :

1 : comment je puis faire pr garder la mise en page du document d'origine? la fonction qui permettrais ceci?

2 : comment je peux faire pr récupérer le nom des feuilles lors d'un enregistrement... ceci ds mon exemple.

enfait le seul tit pb avec ton exemple, c que je récupére absolument tout ( c une copie conforme) alors que moi je ne veux que

les valeurs,
le format
et la mise en page ( que je ne sais pas comment faire)

merci pr vos lumières

 

[nighthawk]

ah oui..
j'allais oublier....

comment également recopier les images du document

( car avec ma méthode .. ça ne prend pas en compte les images)

 

[_Thierry]

Bonjour NightHawk, Didier, le Forum

Je pense que la méthode de Didier est la plus simple et donc la meilleure. (Je viens de faire tourner en test, je n'ai aucune erreur)

Avec ce code, tu copies tout, et donc tu auras tout !

Par contre ce qui te gènes ce sont les Liens externes c'est ça ?

Je pense que tu peux simplement faire un macro de ce style

Sub KeepOnlyValue()
Dim WS As Worksheet
Dim Cell As Range


For Each WS In Worksheets
&nbsp; &nbsp; For Each Cell In WS.UsedRange
&nbsp; &nbsp; &nbsp; &nbsp; If Cell.Value <> '' Then Cell.Value = Cell.Value
&nbsp; &nbsp; Next Cell
Next WS


End Sub

Qui pourra facilement s'intégrer dans le code proposé par MonCherAmi Didier.

Sinon en plus compliqué, tu peux préserver les calculs internes de tes feuilles, en utilisant un 'LinkTracker' mais c'est assez complexe comme code :

Sub TraceLink()
Dim Alink As Variant
Dim TheLink As String
Dim i As Byte

Alink = ActiveWorkbook.LinkSources(xlExcelLinks)

If Not IsEmpty(Alink) Then
&nbsp; &nbsp; For i = 1 To UBound(Alink)
&nbsp; &nbsp; &nbsp; &nbsp; TheLink = Alink(i)
&nbsp; &nbsp; &nbsp; &nbsp; CreatorLinkString TheLink
&nbsp; &nbsp; Next i
End If
End Sub
Sub CreatorLinkString(Link As String)
Dim Contenu As Variant
Dim FileName As String, TheLink As String
Dim X As Byte, LenTotal As Byte, LenFichier As Byte

LenTotal = Len(Link)
&nbsp;
Contenu = Split(Link, Chr(92))
X = UBound(Contenu)
FileName = Contenu(X)
LenFichier = Len(FileName)

TheLink = Left(Link, LenTotal - LenFichier) & '[' & FileName & ']'
TraceWSLink TheLink

End Sub



Sub TraceWSLink(Link As String)
Dim WS As Worksheet
Dim Cell As Range
Dim FirstAddress As String
For Each WS In ActiveWorkbook.Worksheets
With WS.UsedRange
&nbsp; &nbsp; Set Cell = .Find(Link, LookIn:=xlFormulas)
&nbsp; &nbsp; If Not Cell Is Nothing Then
&nbsp; &nbsp; &nbsp; &nbsp; FirstAddress = Cell.Address
&nbsp; &nbsp; &nbsp; &nbsp; Do
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Cell = Cell.Value
&nbsp; &nbsp; &nbsp; &nbsp; Loop While Not Cell Is Nothing And Cell.Address <> FirstAddress
&nbsp; &nbsp; End If
End With
Next
End Sub

Je pense qu'il vaut mieux parfois voir le problème à l'envers, comme ici... J sais c'est un peu aussi une déformation des informaticiens de faire tout à l'envers lol...

Bonne fin de Journée
@+Thierry

 

[nighthawk]

slt, Thierry

j'ai essayé ta manière de faire :

il me met une jolie erreur :
'Impossible de modifier une partie de la matrice '

et qd je clique sur déboger il met en jaune ceci :
Cell.Value = Cell.Value

autre chose qd tu parles de 'Liens externes ' ce sont, par exemple, les formules qui apparaissent ds ma feuille lorsque je clique sur une case de la feuille : si c cela : oui... je ne voudrais garder que la valeur ( le format et la mise en page...)

voila....
en attendant tes lumières...
merci

 

[_Thierry]

Bonsoir NightHawk,

arf, entre l'erreur que tu as sur les quelques lignes de codes de Didier, plus maintenant 'Impossible de modifier une partie de la matrice', arf !!! quelle version d'Excel, Windows ?

Pour \\'Liens externes \\' j'entends \\'Liens externes \\' !!! lol c'est à dire vers des fichiers autres ...

Si tu écris en 'A1' ===> '=A2+A3' cà ce n'est pas un \\'Lien externe \\'....

Bonne nuit
@+Thierry

 

[nighthawk]

re bonsoir,

Moi aussi ça me soule ces erreurs bizarres!
je ne crois pas que ce soit Excel...
maintenant ce qu'il me dit c que l'erreur serait sur ça
' Cell.Value = Cell.Value '

enfin ... si t'as d'autres idées ou qq'un d'autre : suis preneur

bonne nuit.

 

[_Thierry]

Re bonne nuit

Oui mais c'est pas une blague, quelle version d'Excel et de Windows, ça peut nous aider pour te dépatouiller...

Pour :
Cell.Value = Cell.Value

C'est rien, c'est basic, je dis que la valeur de la Cell (NB déclarée 'As Range' dans une bouche for 'Each in WS.UsedRange) devient la Valeur de la Cell (NB déclarée 'As Range' dans une bouche for 'Each in WS.UsedRange)

Rien de bien sorcier... ça devrait passer même sous Excel 97 avec Win 95...

Re Buenas Notchas !
@+Thierry

 

[nighthawk]

Bonjour

moi c XP, avec Office XP

dc si je comprends bien pr un système comme 2000 avec Excel 97
ça passe nikel?

je peux tester ça mardi je crois
je te tiens au courant...

 

[nighthawk]

Bonjour!
la forme?

voila Thierry comme promis, réponse sous un autre OS
là je suis sous Excel 2000, avec un win 2000 pro.

j'utlise la fonction

Sub KeepOnlyValue_mix()
Dim WS As Worksheet
Dim Cell As Range

For Each WS In Worksheets
    For Each Cell In WS.UsedRange
        If Cell.Value <> '' Then Cell.Value = Cell.Value
    Next Cell
Next WS

 Application.Dialogs(xlDialogSaveAs).Show 'NouveauClasseur'
End Sub

et malheureusement j'ai toujours la meme erreur
=> impossible de modifier une partie de la matrice :aprés clique sur déboger
il me met sur ' Cell.Value = Cell.Value '

je pense que ça doit marcher pr toi, mais moi non

_______________________________________________________________

Par contre j'ai essayé de faire d'une autre manière (en trouvant des exemples et tout... ) vu que je connais rien!

Sub cut_paste_ccm_bis()

    Application.ScreenUpdating = False

    Dim I               As Integer  ' indice pour boucles For
    Dim F               As Integer  ' pour ajout de feuilles si besoin
    Dim Nbr             As Integer  ' nombre de feuilles à copier
    Dim NomFeuille(255) As String   ' noms stockés en table
    Dim FicSource       As Workbook ' classeur source
    
    Set FicSource = ActiveWorkbook
    
    ' Stockage en table des feuilles à copier
    Nbr = 0
    For Each feuille In FicSource.Windows(1).SelectedSheets
        Nbr = Nbr + 1
        NomFeuille(Nbr) = feuille.Name
    Next

     For Each feuille In Worksheets
        feuille.Activate
    Next
    
    Workbooks.Add
    
    ' Boucle de copie
    F = 0
    For I = 1 To Nbr
        FicSource.Sheets(NomFeuille(I)).Cells.Copy
        F = F + 1
        If F > Worksheets.Count Then
            Sheets.Add after:=Sheets(Worksheets.Count)
        End If
        Sheets('Feuil' & F).Select
        ActiveSheet.Paste
        Cells.Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Cells.Copy
        Cells(1, 1).Select
    Next

    ' Sauvegarde du nouveau classeur
    Application.Dialogs(xlDialogSaveAs).Show 'NouveauClasseur'
    Application.ScreenUpdating = True

End Sub

avec ceci le pb c que lorsque je choisis plus de ' feuilles, il me met ça :

Une formule ou une feuille que vous voulez déplacer contient déjà le nom ‘E’ qui existe déjà sur la feuille de destination.
Voulez vous utiliser cette version de nom ?
Pr utiliser la version du nom existante cliquez sur oui
Pr renommer la page etc…. Cliquez sur non


aprés 30 clique sur oui ! :S (voir plus)
il me recopie bien ce qu'il faut...

vous savez pkoi? ou comment je pourrais lui dire que 'automatiquement' de dire oui a ces questions
ou carrément désactiver ceci? jusqu'a fin de l'opération?

merci pr votre aide !

 

[nighthawk]

re

j'aimerais récupérer dans le nouveau document qui est crée que les zones d'impréssions dans les feuilles sélectionnées
(et si jamais on a pas défini des zones d'impréssions dans ces feuilles: on copie tout dans le nouveau document...)


comment peut on faire ceci?
merci de votre aide

 

[_Thierry]

Bonjour NightHawk, le Forum

Pour ton problème sur '=> impossible de modifier une partie de la matrice' ... As tu des Cellules Fusionnées ?, car je ne m'explique pas vraiment autre chose...

Essaie quand même ceci :

Option Explicit

Sub KeepOnlyValueViaVariable()
Dim WS As Worksheet
Dim Cell As Range
Dim Temp As Variant

For Each WS In Worksheets
&nbsp; &nbsp; For Each Cell In WS.UsedRange
&nbsp; &nbsp; &nbsp; &nbsp; If Cell.Value <> '' Then
&nbsp; &nbsp; &nbsp; &nbsp; Temp = Cell.Value
&nbsp; &nbsp; &nbsp; &nbsp; Cell.Value = Temp
&nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; Next Cell
Next WS
End Sub

Pour ton problème de zones d'impréssion, ça n'a vraiment strictement rien à voir, et là par contre je suggère de démarrer un autre fil de discussion comme nous l'avons prévu dans notre Charte

Bon Après Midi
@+Thierry

 

[nighthawk]

re Thierry

ok pr la zone d'impréssion

par contre ta modif : rien ... il me remet la meme erreur
et c'est à cette ligne là :

 Cell.Value = Temp

si meme les spécialistes ne trouvent pas, je vais aller bien loin :ermm: