[alderanuri]

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.

[Tarkan VURAL]

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

[alderanuri]

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

[alderanuri]

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.

[Ersin Turgut]

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