arkadaşlar enter tuşuna bastığım zaman istediğim makroyu çalştırma imkanı varmı
elimdeki makroyu entere bastığımda çalışşın istiyorum
elimdeki makroyu entere bastığımda çalışşın istiyorum
Sub Düğme2_Tıklat()
'
' Düğme2_Tıklat Makro
'
'
ActiveSheet.Unprotect
Dim Nesne As Shape
For Each Nesne In ActiveSheet.Shapes
If Nesne.Type <> 8 And Nesne.Type <> 12 Then
Nesne.Delete
End If
Next
Dim STR As Long, RSM As Variant, BŞL As Variant
Dim YL As String
Application.ScreenUpdating = False
YL = ThisWorkbook.Path & "\Personel Resimleri\"
For Each RSM In ActiveSheet.Shapes
If RSM.Type = 13 Then RSM.Delete
Next
BŞL = ActiveCell.Address
For STR = 4 To Cells(Rows.Count, "E").End(xlUp).Row
Cells(STR, "I").Select
ActiveSheet.Pictures.Insert(YL & Cells(STR, "E").Text & ".jpg").Select
Selection.Top = ActiveCell.Top
Selection.Left = ActiveCell.Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 120
Selection.ShapeRange.Width = 80
Next
Range(BŞL).Select
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
MsgBox "İşlem Tamamlandı", vbInformation
End Sub