Soyez le premier à donner votre avis sur cette source.
Vue 2 883 fois - Téléchargée 213 fois
'Dans un modul, entrez ceci (projet/module) Public Const FO_COPY = &H2 Public Const FO_DELETE = &H3 Public Const FO_MOVE = &H1 Public Const FO_RENAME = &H4 Public Const FOF_CONFIRMMOUSE = &H2 Public Const FOF_ALLOWUNDO = &H40 Public Const FOF_FILESONLY = &H80 Public Const FOF_MULTIDESTFILES = &H1 Public Const FOF_NOCONFIRMATION = &H10 Public Const FOF_NOCONFIRMMKDIR = &H200 Public Const FOF_NO_CONNECTED_ELEMENTS = &H1000 Public Const FOF_NOCOPYSECURITYATTRIBS = &H800 Public Const FOF_NOERRORUI = &H400 Public Const FOF_RENAMEONCOLLISION = &H8 Public Const FOF_SILENT = &H4 Public Const FOF_SIMPLEPROGRESS = &H100 Public Const FOF_WANTMAPPINGHANDLE = &H20 Public Const FOF_WANTNUKEWARNING = &H2000 Public Const FOF_NORECURSION = &H1000 '// don't recurse into directories. Public Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As String End Type Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _ (Dest As Any, Sourc As Any, ByVal Length As Long) Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _ (lpFileOp As Any) As Long Public Function copier(FROM As String, copie As String) On Error GoTo erreur Dim fso, msg Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(FROM) Then 'on verifie si le fichier existe copier = "Le fichier n'existe pas" Exit Function erreur: copier = "Une erreur c'est produite" Exit Function End If Dim fos As SHFILEOPSTRUCT ' structure to pass to the function Dim retval As Long ' return value With fos .hWnd = 0 'ou Me.hWnd si on a une Feuille par exemple .wFunc = FO_COPY 'Action == Copie .pFrom = FROM & vbNullChar 'Source path .pTo = copie & vbNullChar 'Dest Path .fFlags = FOF_NOCONFIRMMKDIR Or FOF_WANTMAPPINGHANDLE 'Flags de Copie .fAnyOperationsAborted = 0 .hNameMappings = 0 .lpszProgressTitle = vbNullChar End With retval = SHFileOperation(fos) copier = "Projet créé" End Function 'Ensuite entrez ceci sur le bouton créer Private Sub Command1_Click() Dim name$, chemin1$, chemin2$, total1$, total2$, rep% name = Text1.Text chemin1 = Dir1.Path chemin2 = Dir2.Path total1 = CStr(chemin1) & "\" & "projet1.vbp" total2 = CStr(chemin2) & "\" & CStr(name) & ".vbp" resultat = copier(total1, total2) If resultat = "Projet créé" Then message = CStr(resultat) & " Voulez-vous quitter ?" rep = MsgBox("" & message, vbYesNo, "Résultat") If rep = 6 Then Unload Me Else MsgBox "" & resultat, vbCritical, "Résultat" End If End Sub
'Fin mwa jlé toujours di vu ke j'en é jamé piké a ceux ki on di ke je leur en é piké alors ke c eux ki m'on pikés ceux ke je leur avé piké au départ de ceux ki me lavé piké qui me l'on piké pour dire ke c t mwa ki leur avé piké à ceux ki me l'on piké.
Bien que tu l'es modifier, c'est plus gentil de mentionner ou tu la prise.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.