• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

[Çözüldü] Başka Hücreye Taşınan Resmin Numara Değiştirmesi

  • Konbuyu başlatan Konbuyu başlatan BedriA
  • Başlangıç tarihi Başlangıç tarihi
Katılım
3 Haziran 2017
Mesajlar
797
Excel Vers. ve Dili
2007, 32
Arkadaşlar,

Ekteki örnek dosyada Sayfa 1'e eklenmiş resimler var.
Makro ile bazen ilk resmi silip alttakileri bir üste kaydırıyorum.
Bu durumda resimlerin sayfa numaraları taşındıkları hücrenin numarası ile değişmiyor. Değişmeyince de o resimleri artık makro ile silemiyorum.

Örneğin ilk resim silinince, onun yerine gelen resim "8" olması gerekirken, "9" oluyor. Taşındıktan sonra "9" olan, "8" olsun istiyorum.

Yardımcı olabilir misiniz?
 

Ekli dosyalar

Son düzenleme:
Kullandığım makroya bazı ilaveler yapınca sorun düzeldi.

Kod:
Private Sub CommandButton27_Click()
If ComboBox2.Value = "1." And sablon.OptionButton1 = True Then
On Error Resume Next
 Sheets("bes").Shapes("8").Delete
 Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
Sheets("bes").Shapes("10").Select
Selection.Name = "9"
Sheets("bes").Shapes("9").Select
Selection.Name = "8"
    Sheets("bes").Select
    Range("E8").Select
    Selection.ClearContents
    Range("E9:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "2." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("9").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
Sheets("bes").Shapes("10").Select
Selection.Name = "9"
    Sheets("bes").Select
    Range("E9").Select
    Selection.ClearContents
    Range("E10:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "3." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("10").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
    Sheets("bes").Select
    Range("E10").Select
    Selection.ClearContents
    Range("E11:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E10").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "4." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("11").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
    Sheets("bes").Select
    Range("E11").Select
    Selection.ClearContents
    Range("E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E11").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "5." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("12").Delete
    Sheets("bes").Select
    Range("E12").Select
    Selection.ClearContents
 
    End If

End Sub
 
Son düzenleme:
Resimlerden birini sildiğin zaman bu makroyu çalıştır.

Kod:
Sub resimleridüzelt()

Dim s1
Set s1 = Sheets(ActiveSheet.Name)
Dim Picture As Object
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
'MsgBox TypeName(s1.Shapes(Picture.Name).OLEFormat.Object)
MsgBox Picture.TopLeftCell.Row '.Address
s1.Shapes(Picture.Name).OLEFormat.Object.Name = "denemeW & " & Picture.TopLeftCell.Row
End If
Next Picture


For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
'MsgBox TypeName(s1.Shapes(Picture.Name).OLEFormat.Object)
s1.Shapes(Picture.Name).OLEFormat.Object.Name = Picture.TopLeftCell.Row
End If
Next Picture


MsgBox "İŞLEM TAMAM"""

End Sub
 
Resimlerden birini sildiğin zaman bu makroyu çalıştır.

Kod:
Sub resimleridüzelt()

Dim s1
Set s1 = Sheets(ActiveSheet.Name)
Dim Picture As Object
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
'MsgBox TypeName(s1.Shapes(Picture.Name).OLEFormat.Object)
MsgBox Picture.TopLeftCell.Row '.Address
s1.Shapes(Picture.Name).OLEFormat.Object.Name = "denemeW & " & Picture.TopLeftCell.Row
End If
Next Picture


For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
'MsgBox TypeName(s1.Shapes(Picture.Name).OLEFormat.Object)
s1.Shapes(Picture.Name).OLEFormat.Object.Name = Picture.TopLeftCell.Row
End If
Next Picture


MsgBox "İŞLEM TAMAM"""

End Sub

Ben 1 metre kadar bir kod ile olayı çözmüştüm oysa. :)
Şimdi böyle kısacık bir çözümü olduğunu görünce kötü hissettim. :)

Teşekkürler Halit Hocam.
 
3 ayrı sayfadan Combobox ve OptionButton seçimlerine göre veri silme,
geriye kalanları düzenleme makrosu.

Çok mu uzun oldu acaba? :)


Kod:
Private Sub CommandButton27_Click()
If ComboBox2.Value = "1." And sablon.OptionButton1 = True Then
On Error Resume Next
 Sheets("bes").Shapes("8").Delete
 Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
Sheets("bes").Shapes("10").Select
Selection.Name = "9"
Sheets("bes").Shapes("9").Select
Selection.Name = "8"
    Sheets("bes").Select
    Range("E8").Select
    Selection.ClearContents
    Range("E9:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "2." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("9").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
Sheets("bes").Shapes("10").Select
Selection.Name = "9"
    Sheets("bes").Select
    Range("E9").Select
    Selection.ClearContents
    Range("E10:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "3." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("10").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
Sheets("bes").Shapes("11").Select
Selection.Name = "10"
    Sheets("bes").Select
    Range("E10").Select
    Selection.ClearContents
    Range("E11:E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E10").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "4." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("11").Delete
Sheets("bes").Shapes("12").Select
Selection.Name = "11"
    Sheets("bes").Select
    Range("E11").Select
    Selection.ClearContents
    Range("E12").Select
    Range("E12").Activate
    Selection.Cut
    Range("E11").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "5." And sablon.OptionButton1 = True Then
On Error Resume Next
Sheets("bes").Shapes("12").Delete
    Sheets("bes").Select
    Range("E12").Select
    Selection.ClearContents
 
    End If

If ComboBox2.Value = "1." And sablon.OptionButton3 = True Then

On Error Resume Next
 Sheets("sekiz").Shapes("8").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Shapes("13").Select
Selection.Name = "12"
Sheets("sekiz").Shapes("12").Select
Selection.Name = "11"
Sheets("sekiz").Shapes("11").Select
Selection.Name = "10"
Sheets("sekiz").Shapes("10").Select
Selection.Name = "9"
Sheets("sekiz").Shapes("9").Select
Selection.Name = "8"

    Sheets("sekiz").Select
    Range("E8").Select
    Selection.ClearContents
    Range("E9:E15").Select
    Range("E12").Activate
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "2." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("9").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Shapes("13").Select
Selection.Name = "12"
Sheets("sekiz").Shapes("12").Select
Selection.Name = "11"
Sheets("sekiz").Shapes("11").Select
Selection.Name = "10"
Sheets("sekiz").Shapes("10").Select
Selection.Name = "9"
    Sheets("sekiz").Select
    Range("E9").Select
    Selection.ClearContents
    Range("E10:E15").Select
    Range("E12").Activate
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "3." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("10").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Shapes("13").Select
Selection.Name = "12"
Sheets("sekiz").Shapes("12").Select
Selection.Name = "11"
Sheets("sekiz").Shapes("11").Select
Selection.Name = "10"
    Sheets("sekiz").Select
    Range("E10").Select
    Selection.ClearContents
    Range("E11:E15").Select
    Range("E12").Activate
    Selection.Cut
    Range("E10").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "4." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("11").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Shapes("13").Select
Selection.Name = "12"
Sheets("sekiz").Shapes("12").Select
Selection.Name = "11"
    Sheets("sekiz").Select
    Range("E11").Select
    Selection.ClearContents
    Range("E12:15").Select
    Range("E12").Activate
    Selection.Cut
    Range("E11").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "5." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("12").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Shapes("13").Select
Selection.Name = "12"

    Sheets("sekiz").Select
    Range("E12").Select
    Selection.ClearContents
    Range("E13:15").Select
    Range("E13").Activate
    Selection.Cut
    Range("E12").Select
    ActiveSheet.Paste
    End If
If ComboBox2.Value = "6." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("13").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Shapes("14").Select
Selection.Name = "13"
Sheets("sekiz").Select
    Range("E13").Select
    Selection.ClearContents
    Range("E14:15").Select
    Range("E14").Activate
    Selection.Cut
    Range("E13").Select
    ActiveSheet.Paste
    End If


If ComboBox2.Value = "7." And sablon.OptionButton3 = True Then
On Error Resume Next
Sheets("sekiz").Shapes("14").Delete
Sheets("sekiz").Shapes("15").Select
Selection.Name = "14"
Sheets("sekiz").Select
    Range("E14").Select
    Selection.ClearContents
    Range("15").Select
    Range("E15").Activate
    Selection.Cut
    Range("E14").Select
    ActiveSheet.Paste
    End If

If ComboBox2.Value = "8." And sablon.OptionButton3 = True Then
Sheets("sekiz").Shapes("15").Delete
   Range("E15").Select
    Selection.ClearContents

    End If
    
If ComboBox2.Value = "1." And sablon.OptionButton5 = True Then

On Error Resume Next
 Sheets("on").Shapes("8").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Shapes("13").Select
Selection.Name = "12"
Sheets("on").Shapes("12").Select
Selection.Name = "11"
Sheets("on").Shapes("11").Select
Selection.Name = "10"
Sheets("on").Shapes("10").Select
Selection.Name = "9"
Sheets("on").Shapes("9").Select
Selection.Name = "8"

    Sheets("on").Select
    Range("E8").Select
    Selection.ClearContents
    Range("E9:E17").Select
    Range("E12").Activate
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "2." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("9").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Shapes("13").Select
Selection.Name = "12"
Sheets("on").Shapes("12").Select
Selection.Name = "11"
Sheets("on").Shapes("11").Select
Selection.Name = "10"
Sheets("on").Shapes("10").Select
Selection.Name = "9"
    Sheets("on").Select
    Range("E9").Select
    Selection.ClearContents
    Range("E10:E17").Select
    Range("E12").Activate
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "3." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("10").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Shapes("13").Select
Selection.Name = "12"
Sheets("on").Shapes("12").Select
Selection.Name = "11"
Sheets("on").Shapes("11").Select
Selection.Name = "10"
    Sheets("on").Select
    Range("E10").Select
    Selection.ClearContents
    Range("E11:E17").Select
    Range("E12").Activate
    Selection.Cut
    Range("E10").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "4." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("11").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Shapes("13").Select
Selection.Name = "12"
Sheets("on").Shapes("12").Select
Selection.Name = "11"
    Sheets("on").Select
    Range("E11").Select
    Selection.ClearContents
    Range("E12:17").Select
    Range("E12").Activate
    Selection.Cut
    Range("E11").Select
    ActiveSheet.Paste
    End If
    
If ComboBox2.Value = "5." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("12").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Shapes("13").Select
Selection.Name = "12"

    Sheets("on").Select
    Range("E12").Select
    Selection.ClearContents
    Range("E13:17").Select
    Range("E13").Activate
    Selection.Cut
    Range("E12").Select
    ActiveSheet.Paste
    End If
If ComboBox2.Value = "6." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("13").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Shapes("14").Select
Selection.Name = "13"
Sheets("on").Select
    Range("E13").Select
    Selection.ClearContents
    Range("E14:17").Select
    Range("E14").Activate
    Selection.Cut
    Range("E13").Select
    ActiveSheet.Paste
    End If


If ComboBox2.Value = "7." And sablon.OptionButton5 = True Then
On Error Resume Next
Sheets("on").Shapes("14").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"
Sheets("on").Shapes("15").Select
Selection.Name = "14"
Sheets("on").Select
    Range("E14").Select
    Selection.ClearContents
    Range("15:17").Select
    Range("E15").Activate
    Selection.Cut
    Range("E14").Select
    ActiveSheet.Paste
    End If

If ComboBox2.Value = "8." And sablon.OptionButton5 = True Then
Sheets("on").Shapes("15").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Sheets("on").Shapes("16").Select
Selection.Name = "15"

Sheets("on").Shapes("16").Select
Selection.Name = "15"

   Range("E15").Select
    Selection.ClearContents
    Range("16:17").Select
    Range("E16").Activate
    Selection.Cut
    Range("E15").Select
    ActiveSheet.Paste
    End If

If ComboBox2.Value = "9." And sablon.OptionButton5 = True Then
Sheets("on").Shapes("16").Delete
Sheets("on").Shapes("17").Select
Selection.Name = "16"
Selection.Name = "15"

   Range("E16").Select
    Selection.ClearContents
    Range("17").Select
    Range("E17").Activate
    Selection.Cut
    Range("E16").Select
    ActiveSheet.Paste


End If

If ComboBox2.Value = "10." And sablon.OptionButton5 = True Then
Sheets("on").Shapes("17").Delete
Sheets("on").Shapes("16").Delete
   Range("E17").Select
    Selection.ClearContents

End If

End Sub
 

Ekli dosyalar

  • 1.jpg
    1.jpg
    10.7 KB · Görüntüleme: 4
  • 2.jpg
    2.jpg
    9 KB · Görüntüleme: 3
Geri
Üst