דילוג לתוכן
  • דף הבית
  • קטגוריות
  • פוסטים אחרונים
  • משתמשים
  • חיפוש
  • חוקי הפורום
כיווץ
תחומים

תחומים - פורום חרדי מקצועי

💡 רוצה לזכור קריאת שמע בזמן? לחץ כאן!
  1. דף הבית
  2. תכנות
  3. תקלה בקוד VBA באקסס

תקלה בקוד VBA באקסס

מתוזמן נעוץ נעול הועבר תכנות
2 פוסטים 1 כותבים 138 צפיות 1 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • אבייא
    אבייא
    אביי
    כתב ב נערך לאחרונה על ידי
    #1

    יש לי מלא פעמים שגיאות בקוד VBA שכתבתי במחשב מסויים, כשאני מפעיל אותו במחשב אחר, הבנתי שזה קשור לX32 ו X64, זה נכון? וא"כ איך פוטרים את זה?

    מצרף כמה קודים שנתקעים לי במחשב החדש, בעוד בישן הם עבדו חלק.

    זה קוד להבאת שערי המט"ח מבנק ישראל: זה השגיאה שמופיעה בהרצה
    eb764767-4128-4b40-ac86-aac2e8be7775-image.png

    Option Compare Database
    Option Explicit
    
    #If Win64 Then
        Public Declare PtrSafe Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As LongPtr, ByVal dwReserved As Long) As Boolean
        #Else
        Public Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
        #End If
    
    Public Function GetNISExchangeRate(Optional dtDate As Date = #1/1/1900#, Optional strCurr As String = "01") As Double
    
        Dim strURL As String
        Dim strResult As String
        Dim lngStartPosition As Long
        Dim lngEndPosition As Long
        Dim strFirstSearch As String
        Dim strLastSearch As String
        Dim dtPreviousDate As Date
        Dim i As Integer
    
        strFirstSearch = "<RATE>"
        strLastSearch = "</RATE>"
    
        If dtDate = #1/1/1900# Then
            dtDate = Date
        End If
    
        Select Case strCurr
            Case "01", "02", "03", "05", "06", "12", "17", "18", "27", "28", "31", "69", "70", "79"
            Case Else
                MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
                Exit Function
        End Select
    
        If IsConnected Then
            strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(IIf(dtPreviousDate > 1, dtPreviousDate, dtDate), "YYYYMMDD") & "&curr=" & strCurr
            strResult = GetHTML(strURL)
            If InStr(1, strResult, strFirstSearch) < 1 Then
                For i = 1 To 6
                    dtPreviousDate = dtDate - i
                    strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(dtPreviousDate, "YYYYMMDD") & "&curr=" & strCurr
                    strResult = GetHTML(strURL)
                    If InStr(1, strResult, strFirstSearch) > 0 Then Exit For
                Next i
            End If
        Else
            MsgBox "לא זוהה חיבור לאינטרנט!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
        End If
    
        If Len(strResult) > 0 Then
            lngStartPosition = InStr(1, strResult, strFirstSearch, vbTextCompare)
            lngEndPosition = CLng(InStr(1, strResult, strLastSearch, vbTextCompare))
            If lngStartPosition > -1 Then
                GetNISExchangeRate = Mid(strResult, lngStartPosition + Len(strFirstSearch), lngEndPosition - CLng(lngStartPosition + Len(strFirstSearch)))
            End If
        End If
       
    End Function
    
    Function IsConnected() As Boolean
        Dim Stat As Long
        IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
    End Function
    
    Function GetHTML(strURL As String) As String
        Dim HTML As String
        With CreateObject("MSXML2.ServerXMLHTTP.6.0")
            .Open "GET", strURL, False
            .Send
            GetHTML = .ResponseText
        End With
    End Function
    
    

    השגיאות הם בשורה 60

    ניתן ליצור עימי קשר 8140hp+t@gmail.com | קטלוג מוצרים
    abaye.co

    אבייא תגובה 1 תגובה אחרונה
    0
    • אבייא אביי

      יש לי מלא פעמים שגיאות בקוד VBA שכתבתי במחשב מסויים, כשאני מפעיל אותו במחשב אחר, הבנתי שזה קשור לX32 ו X64, זה נכון? וא"כ איך פוטרים את זה?

      מצרף כמה קודים שנתקעים לי במחשב החדש, בעוד בישן הם עבדו חלק.

      זה קוד להבאת שערי המט"ח מבנק ישראל: זה השגיאה שמופיעה בהרצה
      eb764767-4128-4b40-ac86-aac2e8be7775-image.png

      Option Compare Database
      Option Explicit
      
      #If Win64 Then
          Public Declare PtrSafe Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As LongPtr, ByVal dwReserved As Long) As Boolean
          #Else
          Public Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
          #End If
      
      Public Function GetNISExchangeRate(Optional dtDate As Date = #1/1/1900#, Optional strCurr As String = "01") As Double
      
          Dim strURL As String
          Dim strResult As String
          Dim lngStartPosition As Long
          Dim lngEndPosition As Long
          Dim strFirstSearch As String
          Dim strLastSearch As String
          Dim dtPreviousDate As Date
          Dim i As Integer
      
          strFirstSearch = "<RATE>"
          strLastSearch = "</RATE>"
      
          If dtDate = #1/1/1900# Then
              dtDate = Date
          End If
      
          Select Case strCurr
              Case "01", "02", "03", "05", "06", "12", "17", "18", "27", "28", "31", "69", "70", "79"
              Case Else
                  MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
                  Exit Function
          End Select
      
          If IsConnected Then
              strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(IIf(dtPreviousDate > 1, dtPreviousDate, dtDate), "YYYYMMDD") & "&curr=" & strCurr
              strResult = GetHTML(strURL)
              If InStr(1, strResult, strFirstSearch) < 1 Then
                  For i = 1 To 6
                      dtPreviousDate = dtDate - i
                      strURL = "http://www.boi.org.il/currency.xml?rdate=" & Format(dtPreviousDate, "YYYYMMDD") & "&curr=" & strCurr
                      strResult = GetHTML(strURL)
                      If InStr(1, strResult, strFirstSearch) > 0 Then Exit For
                  Next i
              End If
          Else
              MsgBox "לא זוהה חיבור לאינטרנט!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
          End If
      
          If Len(strResult) > 0 Then
              lngStartPosition = InStr(1, strResult, strFirstSearch, vbTextCompare)
              lngEndPosition = CLng(InStr(1, strResult, strLastSearch, vbTextCompare))
              If lngStartPosition > -1 Then
                  GetNISExchangeRate = Mid(strResult, lngStartPosition + Len(strFirstSearch), lngEndPosition - CLng(lngStartPosition + Len(strFirstSearch)))
              End If
          End If
         
      End Function
      
      Function IsConnected() As Boolean
          Dim Stat As Long
          IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
      End Function
      
      Function GetHTML(strURL As String) As String
          Dim HTML As String
          With CreateObject("MSXML2.ServerXMLHTTP.6.0")
              .Open "GET", strURL, False
              .Send
              GetHTML = .ResponseText
          End With
      End Function
      
      

      השגיאות הם בשורה 60

      אבייא
      אבייא
      אביי
      כתב ב נערך לאחרונה על ידי
      #2

      גם הקוד הזה עושה לי שגיאות:
      קוד שמריץ תוכנה מסוימת מתוך האקסס.
      76fe5f95-1633-47df-9040-f3b536609490-image.png

      Option Compare Database
      
      Private Sub פקודה0_Click()
          Call Shell("C:\Windows\system32\Taskmgr.exe", vbNormalFocus)
      End Sub
      
      

      ניתן ליצור עימי קשר 8140hp+t@gmail.com | קטלוג מוצרים
      abaye.co

      תגובה 1 תגובה אחרונה
      0

      שלום! נראה שהשיחה הזו מעניינת אותך, אבל עדיין אין לך חשבון.

      נמאס לכם לגלול בין אותם הפוסטים בכל ביקור? כשנרשמים לחשבון, תמיד תחזרו בדיוק למקום שבו הייתם קודם, ותוכלו לבחור לקבל התראות על תגובות חדשות (בין אם במייל, ובין אם בהתראת פוש). תוכלו גם לשמור סימניות ולפרגן ב-upvote לפוסטים כדי להביע הערכה לחברי קהילה אחרים.

      בעזרת התרומה שלך, הפוסט הזה יכול להיות אפילו טוב יותר 💗

      הרשמה התחברות
      תגובה
      • תגובה כנושא
      התחברו כדי לפרסם תגובה
      • מהישן לחדש
      • מהחדש לישן
      • הכי הרבה הצבעות


      בא תתחבר לדף היומי!
      • התחברות

      • אין לך חשבון עדיין? הרשמה

      • התחברו או הירשמו כדי לחפש.
      • פוסט ראשון
        פוסט אחרון
      0
      • דף הבית
      • קטגוריות
      • פוסטים אחרונים
      • משתמשים
      • חיפוש
      • חוקי הפורום