Fusion

Messages

• 1. Fusion , 25 mars 2009, 14:13, par BlueGYN

  VERSION 5.00 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form Form1 Caption = "Publipostage" ClientHeight = 6405 ClientLeft = 165 ClientTop = 735 ClientWidth = 12075 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 6405 ScaleWidth = 12075 StartUpPosition = 3 'Windows Default Begin VB.Frame Frame2 Caption = "&Insertion" Height = 975 Left = 240 TabIndex = 10 Top = 60 Width = 3075 Begin VB.ComboBox Liste_CHAMPS Height = 315 ItemData = "Form1.frx":0000 Left = 300 List = "Form1.frx":000D TabIndex = 12 Text = "NOM" Top = 420 Width = 1095 End Begin VB.ComboBox Liste_CALC Height = 315 ItemData = "Form1.frx":0029 Left = 1620 List = "Form1.frx":0033 TabIndex = 11 Text = "DATE" Top = 420 Width = 1095 End End Begin MSComDlg.CommonDialog CommonDialog1 Left = 5820 Top = 4320 _ExtentX = 847 _ExtentY = 847 _Version = 393216 CancelError = -1 'True End Begin RichTextLib.RichTextBox RichTextBox1 Height = 4455 Left = 240 TabIndex = 5 Top = 1260 Width = 11415 _ExtentX = 20135 _ExtentY = 7858 _Version = 393217 Enabled = -1 'True ScrollBars = 2 OLEDragMode = 0 OLEDropMode = 1 TextRTF = $"Form1.frx":0044 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin VB.Frame Frame1 Caption = "&Saisie" Height = 915 Left = 3540 TabIndex = 0 Top = 120 Width = 8115 Begin VB.CommandButton Command2 Caption = "&REMPLACER" Height = 555 Left = 6120 TabIndex = 8 Top = 180 Width = 1755 End Begin VB.TextBox SIGNATURE Height = 495 Left = 4800 TabIndex = 7 Text = "Dr Bidule" Top = 180 Width = 1215 End Begin VB.TextBox PRENOM Height = 495 Left = 2700 TabIndex = 3 Text = "Gustave" Top = 180 Width = 1215 End Begin VB.TextBox NOM Height = 495 Left = 660 TabIndex = 2 Text = "EIFFEL" Top = 180 Width = 1215 End Begin VB.Label label3 AutoSize = -1 'True Caption = "&Signature" Height = 195 Left = 4020 TabIndex = 6 Top = 180 Width = 675 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Prénom" Height = 195 Left = 2040 TabIndex = 4 Top = 240 Width = 540 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "&Nom" Height = 195 Left = 180 TabIndex = 1 Top = 240 Width = 330 End End Begin VB.Label Label4 Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "APPUYER SUR CTRL+ENTREE POUR LANCER LA CONVERSION" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 540 TabIndex = 9 Top = 5880 Width = 10935 End Begin VB.Menu mnu_FILE Caption = "&Ficher" Begin VB.Menu mnu_OPEN Caption = "&Ouvrir" Shortcut = ^O End Begin VB.Menu mnu_SAVE Caption = "&Enregistrer" Shortcut = ^S End Begin VB.Menu bquit Caption = "-" End Begin VB.Menu mnuQUIT Caption = "&Fermer" End End Begin VB.Menu mnu_EDIT Caption = "&Editer" Begin VB.Menu mnu_REP Caption = "&Remplacer" Shortcut = ^R End Begin VB.Menu b2 Caption = "-" End Begin VB.Menu mnu_WRITE Caption = "&Ouvrir dans WRITE" Shortcut = {F2} End End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub Command1_Click() '--- End Sub Private Sub Command2_Click() '--- mnu_REP_Click End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If (Shift = vbCtrlMask) And (KeyCode = 13) Then mnu_REP_Click End Sub Private Sub Liste_CALC_Click() '--- With RichTextBox1 .SelText = " [" & Liste_CALC.Text & "] " .SetFocus End With End Sub Private Sub Liste_CHAMPS_Click() '--- With RichTextBox1 .SelText = " #" & Liste_CHAMPS.Text & "# " .SetFocus End With End Sub Private Sub mnu_OPEN_Click() '--- On Error GoTo fin With CommonDialog1 .DialogTitle = "Ouvrez un Modèle" .DefaultExt = ".RTF" .Filter = "RTF|*.rtf|DOC|*.doc|Tous|*.*" .ShowOpen RichTextBox1.LoadFile .FileName, rtfRTF End With Form1.SetFocus fin: End Sub Private Sub mnu_REP_Click() '--- Dim RTF As String, Code_Trouve, Remplace_Par Dim i As Integer Dim c As Control RTF = RichTextBox1.TextRTF ' === REMPLACE TOUS LES CHAMPS NOMMES === For i = 0 To Liste_CHAMPS.ListCount - 1 Remplace_Par = Liste_CHAMPS.List(i) Code_Trouve = "#" & Remplace_Par & "#" ' --- Pointe les Noms des TextBOX sur le formulaire --- For Each c In Form1.Controls If TypeName(c) = "TextBox" Then If c.Name = Remplace_Par Then Remplace_Par = c.Text RTF = Replace(RTF, Code_Trouve, Remplace_Par, vbTextCompare) End If End If Next Next i ' === REMPLACE TOUS LES CHAMPS CALCULES === For i = 0 To Liste_CALC.ListCount - 1 Remplace_Par = "" Code_Trouve = "[" & Liste_CALC.List(i) & "]" ' --- Pointe les Codes de calcul sur le formulaire --- Select Case Code_Trouve Case "[DATE]": Remplace_Par = Date Case "[HEURE]": Remplace_Par = Time End Select RTF = Replace(RTF, Code_Trouve, Remplace_Par, vbTextCompare) Next i RichTextBox1.TextRTF = RTF End Sub Private Sub mnu_SAVE_Click() '--- On Error GoTo fin With CommonDialog1 .DialogTitle = "Sauvegarder sous " .FileName = NOM.Text & " " & PRENOM.Text & " " & Replace(CStr(Date), "/", "-") & ".rtf" .ShowSave RichTextBox1.SaveFile .FileName, rtfRTF End With fin: End Sub Private Sub mnu_WRITE_Click() If RichTextBox1.FileName <> "" Then Shell "WRITE.EXE " & Chr(34) & RichTextBox1.FileName & Chr(34), 1 Else MsgBox "Chargez d'abord un Fichier RTF" End If End Sub Private Sub mnuQUIT_Click() End End Sub Private Sub RichTextBox1_DblClick() '--- mnu_WRITE_Click End Sub Private Sub RichTextBox1_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) Dim Droped_FileName As String Droped_FileName = Data.Files(1) ' === TESTE SI C'EST UN RTF === If UCase(Right(Droped_FileName, 4)) <> ".RTF" Then MsgBox "Uniquement les fichiers RTF", vbCritical, "ERREUR DE FICHIER" Exit Sub End If 'If MsgBox(Droped_FileName, vbQuestion + vbOKCancel, "OUVRIR") = vbCancel Then Exit Sub RichTextBox1.LoadFile Droped_FileName, rtfRTF Form1.SetFocus End Sub