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 60 61 62 63 64
| Private Sub Image3_Click()
Dim TheFile As Variant
Dim ThePath As String
Dim UserDir As String
ThePath = "C:\Mes Documents\"
UserDir = CurDir
TheFile = Application.GetOpenFilename("Fichiers bmp/gif/jpg/tiff,*.bmp;*.gif;*.jpg;*.jpeg;*.tiff")
With Me.Image3
.Tag = TheFile
.Picture = LoadPicture(TheFile)
.PictureSizeMode = fmPictureSizeModeZoom
.Height = Application.CentimetersToPoints(5)
.Width = Application.CentimetersToPoints(4)
End With
ChDir UserDir
End Sub
-----------------------------------------------------------------------------------------
Private Sub Nouveau_Click()
Sheets("Contacts ext").Activate
Dim Emplacement As Range
Dim objImg As Variant
Set objImg = ActiveSheet.Pictures.Insert(Image3.Tag)
Set Emplacement = Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = UserForm_1.TextBox_1
Range("C" & Rows.Count).End(xlUp).Offset(0, 1) = UserForm_1.TextBox_2
Range("C" & Rows.Count).End(xlUp).Offset(0, 2) = UserForm_1.TextBox_3
Range("C" & Rows.Count).End(xlUp).Offset(0, 3) = UserForm_1.TextBox_4
Range("C" & Rows.Count).End(xlUp).Offset(0, 4) = UserForm_1.TextBox_5
Range("C" & Rows.Count).End(xlUp).Offset(0, 5) = UserForm_1.TextBox_6
Range("C" & Rows.Count).End(xlUp).Offset(0, 6) = UserForm_1.TextBox_7 & " " & UserForm_1.TextBox_8 & "--" & UserForm_1.TextBox_9 & " " & UserForm_1.TextBox_10
Range("C" & Rows.Count).End(xlUp).Offset(0, 7) = UserForm_1.TextBox_11
Range("C" & Rows.Count).End(xlUp).Offset(0, 0).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 1).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 2).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 3).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 4).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 5).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 6).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, 7).Borders.Weight = xlMedium
Range("C" & Rows.Count).End(xlUp).Offset(0, -1).Borders.Weight = xlMedium
objImg.Select
With objImg.ShapeRange
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
Sheets("A remplir").Activate
Unload Me
End Sub |
Partager