[VBA-E]Collection de bouton ...

**ogenki** · 08/02/2006, 20h57

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Private Sub Workbook_Open()
    Dim butTop, butLeft, Bouton, butHeight, butWidth
    Dim k
    Dim lastline, winindex
    Dim ligne
   ' Dim appxl As Excel.Application, wk As Workbook, wsh As Worksheet
   ' Set wsh = ThisWorkbook.Worksheets(2)
   ' Set sh = wsh.OLEObjects(1)
    Dim XlsFiles() As String
    Dim DocFiles() As String
    lastline = 1
    ligne = 0
 
   ' MkDir "C:\Documents and Settings\avaysse\Mes documents\sauvegarde"
    XlsFiles = FindFiles("C:\Documents and Settings\avaysse\Mes documents\", "xls")
    DocFiles = FindFiles("C:\Documents and Settings\avaysse\Mes documents\", "doc")
    For i = LBound(XlsFiles) To UBound(XlsFiles)
        If XlsFiles(i) = "test2.xls" Then GoTo sortie
'
'
'
'code
'
'
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' creation des liens vers les documents word
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
            butTop = Range("i" & lastline + 7).Top
            butLeft = Range("i" & lastline + 7).Left
            butHeight = Range("i" & lastline + 7).Height
            butWidth = Range("i" & lastline + 7).Width
 
 
        Set Bouton = ActiveSheet.Buttons.Add(Left:=butLeft, Top:=butTop, Width:=butWidth, Height _
            :=butHeight * 2)
        With Bouton
 
            .OnAction = "OpenWorddocs"
            .Name = Repertoire
            .Caption = .Name
        End With
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' fermeture de toute les fenetres et vidé le clipboard
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Application.DisplayAlerts = False
            Workbooks(XlsFiles(i)).Close False
            OpenClipboard 0
            EmptyClipboard
            CloseClipboard
            Application.DisplayAlerts = True
            lastline = lastline + 10
 
sortie:
Next
End Sub

**bidou** · 08/02/2006, 21h00

Dans .Name=Repertoire, il sort d'ou ce Repertoire

**ogenki** · 08/02/2006, 21h03

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function FindFiles(ByVal Repertoire As String, ByVal Extension As String) As String()
 
    Dim Test As String, cmpt As Integer, tabTemp() As String
    Test = Dir(Repertoire & "*." & Extension)
    While Test <> ""
        ReDim Preserve tabTemp(cmpt)
            tabTemp(cmpt) = Test
            cmpt = cmpt + 1
            Test = Dir
    Wend
    FindFiles = tabTemp
 
End Function

**bidou** · 08/02/2006, 21h10

Alors dans ton code ce devrait être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With Bouton 
 
      .OnAction = "OpenWorddocs" 
      .Name = Left(XlsFiles(i),Len(XlsFiles(i))-4)
      .Caption = .Name 
End With

Une question pour ma culture personnelle, pourquoi fais-tu ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
  OpenClipboard 0 
  EmptyClipboard 
  CloseClipboard

**ogenki** · 08/02/2006, 21h13

je sais plus trop... je fait aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

dans mon module...

normalement c'est pour vidé le clipboard c'est une solution qui nous avai etai proposé a spafy et moi...

**ogenki** · 08/02/2006, 21h15

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With Bouton
 
      .OnAction = "OpenWorddocs"
      .Name = Left(XlsFiles(i),Len(XlsFiles(i))-4)
      .Caption = .Name
End With

marche super bien pour le premier mais plante au second bouton... il n'arive pas a definir la proprieté de name...

**bidou** · 08/02/2006, 21h21

c'est curieux

c'est quoi l'erreur exacte ?

**ogenki** · 08/02/2006, 21h24

impossible de definir la proprieté Name de la classe button

voila

EDIT : quand je clique sur le bouton pour debeuger il me surligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Name = Left(XlsFiles(i), Len(XlsFiles(i)) - 4)

( le bouton est créer mais n'a pas le bon nom... il plante juste apres...

**bidou** · 08/02/2006, 21h33

chez moi ca marche sans probleme

**ogenki** · 08/02/2006, 21h37

il est possible que tout les boutons et le meme Name ?

**bidou** · 08/02/2006, 21h46

ah non, chaque nom doit être unique, mais deux fichier d'un même répertoire de peuvent avoir le même nom.

**ogenki** · 09/02/2006, 18h21

aprés discution avec spafy "tout" marche enfin
je vous met le code pour info..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
            butTop = Range("i" & lastline + 7).Top
            butLeft = Range("i" & lastline + 7).Left
            butHeight = Range("i" & lastline + 7).Height
            butWidth = Range("i" & lastline + 7).Width
 
            Set Bouton = ActiveSheet.Buttons.Add(Left:=butLeft, Top:=butTop, Width:=butWidth, Height _
            :=butHeight * 2)
            With Bouton
                .OnAction = "OpenWorddocs"
                'Join(Split(XlsFiles(i), " "), "")
                x = Split(XlsFiles(i), ".")
                .Name = x(0)
                .Caption = .Name
            End With