• DİKKAT

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

Excel sayfasına eklenen makro excel 2010 da çalışmıyor.

  • Konbuyu başlatan Konbuyu başlatan rızay
  • Başlangıç tarihi Başlangıç tarihi
Katılım
9 Eylül 2008
Mesajlar
60
Excel Vers. ve Dili
version 10 Türkçe
Merhaba arkadaşlar.
Hepinize selamlar.Benim sorum şu: Vbasic de yapılmış excel tabanlı dosyamda sayfaya yerleştirdiğim sil makrosu sayfadaki hücrelerdeki verileri ve sütunlardaki fotoğrafları windows 2002,windows 2007 de siliyor,ancak bu dosyayı excel 2010 yüklü bilgisayara yüklüyorum excel sayfasındaki makroyu tıklıyorum, hücredeki verileri siliyor fakat resimleri silmiyor.
Yani excel 2010 yüklü bilgisarda makro fotoğrafları silmiyor.ilgili kodlar ektedir.Yardımcı olacaklara şimdiden çok teşekkür ederim.
Sorun makro güvenlik sorunu olabilir mi? bilmiyorum.Çok acil bekliyorum.
kodlar:
Private Sub ComboBox1_Change()
Dim ts, kaplan, yol, Resim_Memur

Application.ScreenUpdating = False
Range("B6,A8:I65536").ClearContents
Range("A8:A65536").RowHeight = 45
kaplan = 8
yol = "D:\Memur_Isci_Tan\Resim_Mem\"

For Each Resim_Memur In ActiveSheet.Shapes
If Resim_Memur.Type = msoPicture Then Resim_Memur.Delete
Next

For ts = 2 To Sheets("DATABASE").Cells(65536, "I").End(xlUp).Row
If Sheets("DATABASE").Cells(ts, "I") = ComboBox1.Value Then
Cells(kaplan, "A") = Sheets("DATABASE").Cells(ts, "B")
Cells(kaplan, "B") = Sheets("DATABASE").Cells(ts, "C")
Cells(kaplan, "C") = Sheets("DATABASE").Cells(ts, "D")
Cells(kaplan, "D") = Sheets("DATABASE").Cells(ts, "E")
Cells(kaplan, "E") = Sheets("DATABASE").Cells(ts, "G")
Cells(kaplan, "H") = Sheets("DATABASE").Cells(ts, "F")
Cells(kaplan, "G") = Sheets("DATABASE").Cells(ts, "J")
Cells(kaplan, "F") = Sheets("DATABASE").Cells(ts, "H")
Cells(kaplan, "I").Select

On Error Resume Next
ActiveSheet.Pictures.Insert(yol & Cells(kaplan, "H") & ".jpg").Select
With Selection
.Top = Cells(kaplan, "I").Top
.Left = Cells(kaplan, "I").Left
.Width = Cells(kaplan, "I").Width
.Height = Cells(kaplan, "I").Height
End With
On Error GoTo 0

Range("B6") = ComboBox1
Range("B6").Select
kaplan = kaplan + 1
End If
Next

Application.ScreenUpdating = True
End Sub

makro kodu aşağıdadır:
Sub teklik()
Dim ts
Sheets("TANITIM").ComboBox1.Clear
For ts = 2 To Sheets("DATABASE").Cells(65536, "I").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("DATABASE").Range ("I2:I" & ts), _
Sheets("DATABASE").Cells(ts, "I")) = 1 Then
Sheets("TANITIM").ComboBox1.AddItem Sheets("DATABASE").Cells(ts, "I")
End If
Next
End Sub
 
Geri
Üst