Option Explicit
Option Compare Text
Private Declare Function FindWindowA& Lib "User32" _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" _
(ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" _
(ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" _
(ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA(vbNullString, Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
Dim fc As String
Dim x As Long
fc = ThisWorkbook.Path & "\Dossier-Images" & "\fiche.ico"
x = Len(Dir(fc))
If x = 0 Then Exit Sub
x = ExtractIconA(0, fc, 0)
SendMessageA FindWindow(vbNullString, Caption), &H80, False, x
End Sub
Private Sub UserForm_Activate()
Dim hWnd As Long
hWnd = FindWindowA("XLMAIN", Application.Caption)
EnableWindow hWnd, 1
End Sub
Private Sub Affiche_Click()
Dim r As Range
Dim pa As String
Liste.Clear
For Each r In Sheets(1).Range("B2:B" & Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row)
If r Like "*" & Recherche & "*" Then
Liste.AddItem r
Liste.List(Liste.ListCount - 1, 1) = r.Row
End If
Next
End Sub
Private Sub Liste_Click()
Dim cel, nom, rg, li As Long
li = Liste.List(Liste.ListIndex, 1)
rg = Sheets(1).Cells(li, 3)
nom = Sheets(1).Cells(li, 2)
On Error Resume Next
cel = Replace(rg, vbLf, vbCrLf)
'chemin --------------------------------->terminé par \
chemin = "répertoire où tu veux stocker tes Textes"
Fichier = chemin & nom & ".txt"
Open Fichier For Output As #1
Print #1, cel
Close #1
'inutile (ça marche !)
Test
UserForm1.Show
End Sub
Private Sub Fermer_Click()
Unload Me
End Sub
Sub Test()
Dim a$, texte$
Open Fichier For Input As #1
While Not EOF(1)
Input #1, a$
texte = texte & a$ & vbNewLine
Wend
Close #1
UserForm1.TextBox1 = texte
End Sub
