Çözüldü Dim wb As Workbook kısmının 2. kere kullanılmasındaki hata

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Kod: 
Public bekle
Sub DIŞARI_FORMFRT()
MsgBox "EXCEL DOSYASININ OLDUĞU BU DİZİNDE, RAPORLAR VE İÇİNDE DE FORMFRT ADLI KLASÖRÜN OLMALI ", vbExclamation, "FIRAT UYARIYOR!"
Secim = MsgBox("BU ŞARTLAR SAĞLANDI MI?", vbYesNo + vbCritical, "İYİ DÜŞÜN")
If Secim = vbYes Then
Application.Visible = True
ElseIf Secim = vbNo Then
MsgBox "PEKİ, İPTAL EDEYİM BARİ!", vbMsgBoxSetForeground
Exit Sub
End If
    Dim basla, bitir, süre
    Dim i As Long
    basla = Timer
Set HG = Sheets("HÜCRE GİRİŞ"): Set s = Sheets("FORMFRT")
bekle = "DUR"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 xy = InputBox("KAÇ İHALE RAPORLANACAK. YAZ. GT DEKİ SIRALAMA")
 If xy = "" Then
MsgBox "yazmadın, çıkıyorum...", vbInformation, "        Uyarı"
Exit Sub
End If
    For sat = 1 To xy
        s.[V3] = HG.Cells(sat, "Q")
        ActiveSheet.Copy
        belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aa").Value, ":", "="), "/", "&") & ".xlsx"
        
        
        
        
    Columns("U:AH").Select
    Selection.EntireColumn.Hidden = True
    Rows("41:41").Select
    Selection.EntireRow.Hidden = True
    Range("C2").Activate
    
    
        
    Dim wb As Workbook
    Set wb = Application.ActiveWorkbook
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    'bu kod linkleri kesiyor.
        
End If


ActiveWorkbook.SaveAs belge
        ActiveWorkbook.Close
    Next
    For sat = 1 To HG.Cells(Rows.Count, "AK").End(3).Row
    If HG.Cells(sat, "AK").Value <> "" Then
        s.[V3] = HG.Cells(sat, "AI")
        ActiveSheet.Copy
        belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aK").Value, ":", "="), "/", "&") & ".xlsx"
        
        
    Columns("U:AH").Select
    Selection.EntireColumn.Hidden = True
    Rows("41:41").Select
    Selection.EntireRow.Hidden = True
    Range("C2").Activate
    
    
        
    Dim wb As Workbook
    Set wb = Application.ActiveWorkbook
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    'bu kod linkleri kesiyor.
        
End If
        
        
        
        ActiveWorkbook.SaveAs belge
        ActiveWorkbook.Close
        
        
    End If
Next
bekle = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
bekle = ""

bitir = Timer
    
MsgBox "İhalelelerin Dışarı aktarımı " & Format(bitir - basla, "Fixed") & " saniyede Tamamlandı", vbInformation
End Sub
2. kere yazdığım Dim wb As Workbook kısmı hata veriyor. nasıl yazmalıyım.
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Konu başlığınız forum kurallarına aykırı.
Konuyu özetleyen bir biçimde olmalıdır.
Aksi takdirde mederatörler tarafından konunuz siliniyor.:cool:
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Orion1' Alıntı:
Konu başlığınız forum kurallarına aykırı.
Konuyu özetleyen bir biçimde olmalıdır.
Aksi takdirde mederatörler tarafından konunuz siliniyor.:cool:
Genişletmek için tıkla ...
düzenledim. uyarı için teşekkürler ama özel bir konu gibi geldi. :)
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
euphrates55' Alıntı:
Kod: 
Public bekle
Sub DIŞARI_FORMFRT()
MsgBox "EXCEL DOSYASININ OLDUĞU BU DİZİNDE, RAPORLAR VE İÇİNDE DE FORMFRT ADLI KLASÖRÜN OLMALI ", vbExclamation, "FIRAT UYARIYOR!"
Secim = MsgBox("BU ŞARTLAR SAĞLANDI MI?", vbYesNo + vbCritical, "İYİ DÜŞÜN")
If Secim = vbYes Then
Application.Visible = True
ElseIf Secim = vbNo Then
MsgBox "PEKİ, İPTAL EDEYİM BARİ!", vbMsgBoxSetForeground
Exit Sub
End If
    Dim basla, bitir, süre
    Dim i As Long
    basla = Timer
Set HG = Sheets("HÜCRE GİRİŞ"): Set s = Sheets("FORMFRT")
bekle = "DUR"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xy = InputBox("KAÇ İHALE RAPORLANACAK. YAZ. GT DEKİ SIRALAMA")
If xy = "" Then
MsgBox "yazmadın, çıkıyorum...", vbInformation, "        Uyarı"
Exit Sub
End If
    For sat = 1 To xy
        s.[V3] = HG.Cells(sat, "Q")
        ActiveSheet.Copy
        belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aa").Value, ":", "="), "/", "&") & ".xlsx"
       
       
       
       
    Columns("U:AH").Select
    Selection.EntireColumn.Hidden = True
    Rows("41:41").Select
    Selection.EntireRow.Hidden = True
    Range("C2").Activate
   
   
       
    Dim wb As Workbook
    Set wb = Application.ActiveWorkbook
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    'bu kod linkleri kesiyor.
       
End If


ActiveWorkbook.SaveAs belge
        ActiveWorkbook.Close
    Next
    For sat = 1 To HG.Cells(Rows.Count, "AK").End(3).Row
    If HG.Cells(sat, "AK").Value <> "" Then
        s.[V3] = HG.Cells(sat, "AI")
        ActiveSheet.Copy
        belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aK").Value, ":", "="), "/", "&") & ".xlsx"
       
       
    Columns("U:AH").Select
    Selection.EntireColumn.Hidden = True
    Rows("41:41").Select
    Selection.EntireRow.Hidden = True
    Range("C2").Activate
   
   
       
    Dim wb As Workbook
    Set wb = Application.ActiveWorkbook
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    'bu kod linkleri kesiyor.
       
End If
       
       
       
        ActiveWorkbook.SaveAs belge
        ActiveWorkbook.Close
       
       
    End If
Next
bekle = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
bekle = ""

bitir = Timer
   
MsgBox "İhalelelerin Dışarı aktarımı " & Format(bitir - basla, "Fixed") & " saniyede Tamamlandı", vbInformation
End Sub
2. kere yazdığım Dim wb As Workbook kısmı hata veriyor. nasıl yazmalıyım.
Genişletmek için tıkla ...
Dim ile tanıtılan değişken yalnızca bir kere tanımlanabilir.
2nci defa ayni değişken tanımlanamaz.:cool:
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
amacım oluşan excelin linlerini kesmek. nasıl yapabilirim.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Böyle yapın

Rich (BB code): 
Public bekle
Sub DIŞARI_FORMFRT()

Dim wb As Workbook
Set wb = Application.ActiveWorkbook

MsgBox "EXCEL DOSYASININ OLDUĞU BU DİZİNDE, RAPORLAR VE İÇİNDE DE FORMFRT ADLI KLASÖRÜN OLMALI ", vbExclamation, "FIRAT UYARIYOR!"
Secim = MsgBox("BU ŞARTLAR SAĞLANDI MI?", vbYesNo + vbCritical, "İYİ DÜŞÜN")
If Secim = vbYes Then
Application.Visible = True
ElseIf Secim = vbNo Then
MsgBox "PEKİ, İPTAL EDEYİM BARİ!", vbMsgBoxSetForeground
Exit Sub
End If
Dim basla, bitir, süre
Dim i As Long
basla = Timer
Set HG = Sheets("HÜCRE GİRİŞ"): Set s = Sheets("FORMFRT")
bekle = "DUR"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xy = InputBox("KAÇ İHALE RAPORLANACAK. YAZ. GT DEKİ SIRALAMA")
If xy = "" Then
MsgBox "yazmadın, çıkıyorum...", vbInformation, "        Uyarı"
Exit Sub
End If
For sat = 1 To xy
s.[V3] = HG.Cells(sat, "Q")
ActiveSheet.Copy
belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aa").Value, ":", "="), "/", "&") & ".xlsx"

Columns("U:AH").EntireColumn.Hidden = True
Rows("41:41").EntireRow.Hidden = True
Range("C2").Activate

'Dim wb As Workbook
'Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
'bu kod linkleri kesiyor.
End If


ActiveWorkbook.SaveAs belge
ActiveWorkbook.Close
Next
For sat = 1 To HG.Cells(Rows.Count, "AK").End(3).Row
If HG.Cells(sat, "AK").Value <> "" Then
s.[V3] = HG.Cells(sat, "AI")
ActiveSheet.Copy
belge = ThisWorkbook.Path & "\RAPORLAR" & "\FORMFRT\" & Replace(Replace(HG.Cells(sat, "aK").Value, ":", "="), "/", "&") & ".xlsx"


Columns("U:AH").EntireColumn.Hidden = True
Rows("41:41").EntireRow.Hidden = True
Range("C2").Activate

'Dim wb As Workbook
'Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
'bu kod linkleri kesiyor.
End If

ActiveWorkbook.SaveAs belge
ActiveWorkbook.Close

End If
Next
bekle = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
bekle = ""

bitir = Timer

MsgBox "İhalelelerin Dışarı aktarımı " & Format(bitir - basla, "Fixed") & " saniyede Tamamlandı", vbInformation
End Sub
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
mahçup olmayayım diye bir kaç kere denedim ama olmadı halit bey. dosyam sizde var zaten. isterseniz formfrt sekmesindeki koda sizin yazdığınızı eklerseniz sizde bakabilirsiniz.
bu arada dünkü kodları iş yerinde de denedim ama olmadı. sanırım versiyon farkından kaynaklı bir durum var. bunun üstünde durmaya gerek yok artık.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Kodun ne işlem yaptığını bilmiyorum.
(Dim wb As Workbook kısmının 2. kere kullanılmasındaki hata)
Bu sorunuzla ilgili kodda kırmızı bölümleri ekledim ve basif yaptım
böylece iki defa kullanılmamış oldu dim ile tanımlı yordamlar.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
peki anladım. ayrı bir modüle kodlayıp, oradan çağırttırarak hallettim.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst