[Yardım]  Vba6 ve Vba7

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Vba6 ve Vba7

İleti#1)  alderanuri » 12 Haz 2018 03:31

Merhabalar

Bi konuda yardim talebinde bulunacagim.
Vba 6.0 yazdigim makroyu vba 7.0 icinde nasil kullanabilirim.
Vba 7.0 icinde herhangi bi degisiklik var mi?
Kendim incelemedim sadece yazdigim kodlarin calismadigini gördum.
Iyi calismalar dilerim.
Kullanıcı avatarı
alderanuri
 
Adı Soyadı:nuri celik
Kayıt: 19 Oca 2012 21:57
Konum: yurt disi
Meslek: mobilya dekorasyon
Yaş: 36
İleti: 7
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: stockholm

Cevap: Vba6 ve Vba7

İleti#2)  Tarkan VURAL » 12 Haz 2018 10:45

Kodlarda API kullanıyor musunuz? Kulanmıyorsanız sorun yok. Kullanıyorsanız deklerasyonları VBA7 | WIN64' e göre ayarlamanız gerekebilir.
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 20:27
Konum: tarkan@excelvba.net
Meslek: LUU, Yazılım Geliştirme Müdürü
Yaş: 44
İleti: 26744
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

Cevap: Vba6 ve Vba7

İleti#3)  alderanuri » 12 Haz 2018 20:46

Tarkan bey öncelikle teşekkür ederim.
Konunun belki de burası ile alakası yoktur ama
AutoCAD de yazdığım makrolar var.
Eklenti mi gerekli ?
Iyi çalışmalar dilerim
Kullanıcı avatarı
alderanuri
 
Adı Soyadı:nuri celik
Kayıt: 19 Oca 2012 21:57
Konum: yurt disi
Meslek: mobilya dekorasyon
Yaş: 36
İleti: 7
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: stockholm

Cevap: Vba6 ve Vba7

İleti#4)  alderanuri » 28 Haz 2018 16:39

Kod: Tümünü seç
Option Explicit

Dim Ni As NestInformation

Public Sub Test()
  Dim iNumSheets As Integer
  Dim lFirstOp As Long
  Dim lLastOp As Long
  Dim lLastSheetOp As Long
  Dim LastTool As MillTool
  Dim i As Integer
  Dim lCount As Long
  Dim NewOpNo As Long
  Dim NestInfo As NestInformation
  Dim Ns As NestSheet
  Dim colSheetID As New Collection

  Set NestInfo = ActiveDrawing.GetNestInformation
  For Each Ns In NestInfo.Sheets

    If UCase(Right(Ns.Name, 4)) <> "_REV" Then
      colSheetID.Add DetermineSheetID(Ns.Name)
    End If
  Next
 

  Set Ni = ActiveDrawing.GetNestInformation
 
  iNumSheets = colSheetID.Count
 
  Set LastTool = App.SelectTool("T1")
 

  App.DisableUndo = True
  For i = 1 To iNumSheets
    colSheetID (i)
    GetSheetFirstAndLastOperation "Sheet " & colSheetID(i), lFirstOp, lLastOp
    lLastSheetOp = lLastOp
    lCount = lFirstOp
    NewOpNo = lLastOp + 1
    Do While lCount <= lLastSheetOp
    MsgBox (ActiveDrawing.Operations(lCount).Tool.Number)
    MsgBox (ActiveDrawing.Operations(lCount).Tool.Name)
      If ActiveDrawing.Operations(lCount).Tool.Number = "1" _
        And ActiveDrawing.Operations(lCount).Tool.Name = "T1" Then
       
        ActiveDrawing.Operations.Renumber lCount, NewOpNo, acamOpINSERT_IN_FRONT
      End If
      lCount = lCount + 1
    Loop
    ActiveDrawing.Operations.OrderAll
  Next
 
  ActiveDrawing.ZoomAll
End Sub


Public Function DetermineSheetID(SheetName As String) As String
  Dim iCount  As Integer
  Dim sLetter As String
  Dim bFound  As Boolean

  For iCount = Len(SheetName) To 1 Step -1
    If Not IsNumeric(Mid(SheetName, iCount, 1)) Then
      bFound = True
      Exit For
    End If
  Next
  If bFound Then
    sLetter = Mid(SheetName, iCount)
    DetermineSheetID = sLetter
  Else
    MsgBox "Cannot determine Sheet Letter for sheet: " & SheetName, vbExclamation
  End If
End Function


Private Sub GetSheetFirstAndLastOperation(SheetName As String, FirstOp As Long, LastOp As Long)
  Dim TestPath As Path
  Dim lLastOp As Long
  Dim lFirstOp As Long
  Dim iSheetNum As Integer

 
  lLastOp = Ni.Sheets(SheetName).Paths(1).OpNo
  lFirstOp = Ni.Sheets(SheetName).Paths(1).OpNo
  For Each TestPath In Ni.Sheets(SheetName).Paths
    If TestPath.OpNo > lLastOp Then lLastOp = TestPath.OpNo
    If TestPath.OpNo < lFirstOp And TestPath.OpNo <> 0 And TestPath.IsToolPath Then lFirstOp = TestPath.OpNo
  Next
  LastOp = lLastOp
  FirstOp = lFirstOp
 

End Sub



Merhabalar
Bu hazirlamis oldugum kodlar. 32bit versiyonda sorun cikartmiyor.64 bit sisteme gecis yapilinca surekli hata uyarisi veriyor.
Olusan hatanin duzeltilmesi icin yardimci olursaniz memnun olurum.
iyi calismalar dilerim.
Kullanıcı avatarı
alderanuri
 
Adı Soyadı:nuri celik
Kayıt: 19 Oca 2012 21:57
Konum: yurt disi
Meslek: mobilya dekorasyon
Yaş: 36
İleti: 7
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: stockholm

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Vba6 ve Vba7

İleti#5)  Ersin Turgut » 30 Haz 2018 03:32

Merhaba,

Tarkan bey'inde dediği gibi kodlarınızı aşağıdaki örneğe göre güncellemeniz gerekmektedir. Aşağıdaki örnekte clipboard işlemleri var ama kendi apinize göre güncellemeniz gerekli.

Detaylı bilgi: https://docs.microsoft.com/en-us/office/client-developer/shared/compatibility-between-the-32-bit-and-64-bit-versions-of-office

Kod: Tümünü seç
#If VBA7 = 1 Then
    Private Declare PtrSafe Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "USER32" () As Long
    Private Declare PtrSafe Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
#Else
    Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
    Private Declare Function CloseClipboard Lib "USER32" () As Long
    Private Declare Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
#End If
Kullanıcı avatarı
Ersin Turgut
Site Dostu
 
Adı Soyadı:Ersin Turgut
Kayıt: 30 Haz 2010 15:17
Konum: İzmir
Meslek: Bilgi İşlem ve Proje Sorumlusu
Yaş: 34
İleti: 598
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İzmir / Bornova


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 2 misafir

Bumerang - Yazarkafe