ByRef argument type mismatch

Status
Niet open voor verdere reacties.
Bertsjuhn

Bertsjuhn

Gebruiker
Lid geworden
15 jul 2008
Berichten
75
Ik heb een code... met daarin die fout...

Code 1 roept code 2 aan, en code 2 roept code 3 aan...
Bij de aanroep naar code 3 gaat het mis bij
Code: 
sResult$ = FormatSyncXML$(SyncFormId)

Ik krijg de foutmelding zoals in de titel te lezen is.
Heeft iemand een oplossing?


Code 1
Code: 
Private Sub Toggle109_Click()
Dim FormIDVaria

ImportFormDesign "C:\test.pff"
Me.Refresh

FreezeAuto "123123123"
'Activate
Me.Refresh

AutoSync_Click 123123123

End Sub



Code 2
Code: 
Sub AutoSync_Click(SyncFormId%)
  Dim wResult%, sKey$, sSection$, sDefault$, sResult$
  Dim sDefaultPath$
  Dim NL$
  Dim db As Database, rs As Recordset
  Dim addedToDefault%

  NL$ = Chr$(13) & Chr$(10)
  On Error Resume Next
  Err = 0

  sKey$ = "Data2"
  sSection$ = "Locations"
  sDefault$ = CurDir$ & "\PilotF"

  sResult$ = Space$(1024)
  wResult% = GetPrivateProfileString(sSection$, sKey$, sDefault$, sResult$, 1023, INI_FILENAME)

  sDefaultPath$ = Left$(sResult$, wResult%)
  
  'If fileexists%(sDefaultPath$ & "\form.plt") Then
  '  wResult% = MsgBox("Only one Form can be distributed during each HotSync, and there is currently another Form queued for the next HotSync." & NL$ & NL$ & "Would you like to distribute the Form '" & "FORM_ID_123123123" & "' instead?", vbYesNo + vbQuestion, APP_TITLE)
  '  If wResult% <> vbYes Then Exit Sub
  'End If
  
  DoCmd.Hourglass True
  If bUseASCII% Then
    sResult$ = MultiFormSyncString$(sDefaultPath$ & "\form.plt", SyncFormId)
    Open sDefaultPath$ & "\form.plt" For Output As #1
    Print #1, sResult$
    Close #1
  
    Open sDefaultPath$ & "\lookup.plt" For Output As #1
    Print #1, LookupSyncString$()
    Close #1
  End If
  
  sResult$ = FormSyncString$(SyncFormId, True)
  If sResult$ = "" Then
    'An error occurred and a dialog was displayed
    DoCmd.Hourglass False
    Exit Sub
  End If
  
  Err = 0
  Set db = CurrentDb()
  Set rs = db.OpenRecordset("select * from form where formId = " & Format$(SyncFormId), dbOpenDynaset)
  
  If Err = 0 Then
    If Not rs.EOF Then
      rs.Edit
      rs!formDesignText = sResult$
      rs!formDistributionDate = Now
      rs.Update
    End If
  End If
  
  sResult$ = FormatSyncXML$(SyncFormId)
  If sResult$ = "" Then
    'An error occurred and a dialog was displayed
    DoCmd.Hourglass False
    Exit Sub
  End If
  Err = 0
  Set db = CurrentDb()
  Set rs = db.OpenRecordset("select * from form5 where formId = " & Format$(SyncFormId), dbOpenDynaset)
  
  If Err = 0 Then
    If Not rs.EOF Then
      rs.Edit
      rs!ppcDesign = sResult$
      rs.Update
    End If
  End If
  
  Set rs = db.OpenRecordset("select * from group_forms where formId = " & Format$(SyncFormId), dbOpenDynaset)
  
  If rs.EOF Then
    rs.AddNew
    rs!groupname = "Default Group"
    rs!formId = Nz(SyncFormId)
    rs.Update
    addedToDefault% = True
    Err = 0
    'DoCmd.OpenForm "User Group Editor", acNormal, , "groupname = 'Default Group'", acFormPropertySettings, acWindowNormal
  Else
    addedToDefault% = False
  End If
  
  ExportDesignToTextFile SyncFormId, sDefaultPath$ & "\" & Hex$(SyncFormId) & ".PFF"
  
  DoCmd.Hourglass False

  If Err > 0 Then
    MsgBox NO_SYNC_STORE & " " & Error$, vbExclamation, APP_TITLE
  Else
    If addedToDefault% Then
      MsgBox "The Form '" & "FORM_ID_123123123" & "' is now updated for distribution and has been added to the Default user group.", vbInformation, APP_TITLE
    Else
      MsgBox "The Form '" & "FORM_ID_123123123" & "' is now updated for distribution.", vbInformation, APP_TITLE
    End If
  End If

End Sub



Code 3
Code: 
Function FormatSyncXML$(formId&)
  ', sFileDirectory$)

  'return XML text containing the form design visual information as an ASCII string.
  Dim sResult$
  Dim NL$
  Dim eQS$, bQS$
  Dim db As Database
  Dim rs As Recordset
  Dim rsQ As Recordset
  Dim rsF As Recordset
  Dim rsF5 As Recordset
  Dim screenId%, x%, Y%, WIDTH%, HEIGHT%, totalHeight%, effectiveHeight%, computedTop%
  Dim fieldX%, fieldY%, fieldWidth%, fieldHeight%
  Dim flags&, computeXY%, formType%, newPage%
  Dim optBeam%, optBeamReceiveDirty%
  Dim sFormat$, formTitle$, screenTitle$, sTail$, sHead$
  Dim screenFlags&
  Dim sPrefix$, sSuffix$
  Dim sNewImage$, sOldImage$
  Dim destLen As Long
  Dim sourceLen As Long
  Dim yoffset As Long
  Dim resolution As Long
  Dim sDefault$
  Dim sOverride$
  
  sPrefix$ = "" ' "![CDATA["
  sSuffix$ = "" ' "]]"
  
  optBeam% = 0
  optBeamReceiveDirty% = 0
  
  On Error Resume Next
  Err = 0
  
  Set db = CurrentDb()
  
  Set rs = db.OpenRecordset("select * from questionFormat where formId = " & Format$(formId&) & " order by questionId", dbOpenSnapshot)
  Set rsF = db.OpenRecordset("select * from form where formId = " & Format$(formId&), dbOpenSnapshot)
  Set rsF5 = db.OpenRecordset("select * from form5 where formId = " & Format$(formId&), dbOpenSnapshot)
  
  If (Err > 0) Then
    FormatSyncXML$ = ""
    MsgBox "Unable to create form visual design string. " & Error$, vbOKOnly + vbExclamation, "Visual Attributes"
    Exit Function
    
  End If
  
  
  If rsF.EOF Then
    FormatSyncXML$ = ""
    MsgBox "Unable to create form visual design string. " & Error$, vbOKOnly + vbExclamation, "Visual Attributes"
    Exit Function
  End If
  
  screenFlags& = Nz(rsF!screenFlags, 0)
  optBeam% = (Nz(rsF!optBeam, 0) And &H3) * 16
  optBeamReceiveDirty% = rsF!optBeamReceiveDirty
  If optBeamReceiveDirty% Then
    optBeamReceiveDirty% = &H40
  End If
  
  'NL$ = """;" & Chr$(13) & Chr$(10)
  'NL$ = Chr$(13) & Chr$(10)
  NL$ = ""
  
  formTitle$ = Nz(rsF!formName, "Untitled")
  screenTitle$ = formTitle$
  screenId% = 1
  sResult$ = "<form id=""" & Format$(formId&) & """ name=""" & sPrefix$ & XMLEC$(formTitle$) & sSuffix$ & """>"
  x% = 0
  Y% = 16
  computedTop% = 0
  
  newPage% = False
  
  computeXY = False
  If IsNull(rs!questionY) Or (rs!questionY = 0) Then
    FormatSyncXML$ = ""
    'Exit Function
    computeXY = True
  End If
  
  
  sResult$ = sResult$ & "<noEndButton value=""" & BitFormat$(rsF!optNoEndButton) & """/>"
  sResult$ = sResult$ & "<noBackButton value=""" & BitFormat$(rsF!optNoBackButton) & """/>"
  sResult$ = sResult$ & "<fieldLevelValidate value=""" & BitFormat$(rsF!optFieldLevelValidate) & """/>"
  sResult$ = sResult$ & "<autoNavigate value=""" & BitFormat$(rsF!optNoAutoNavigate) & """/>"
  sResult$ = sResult$ & "<noDeleteButton value=""" & BitFormat$(rsF!optNoDeleteButton) & """/>"
  sResult$ = sResult$ & "<hidden value=""" & BitFormat$(rsF!optNotVisible) & """/>"
  sResult$ = sResult$ & "<recLevelUndo value=""" & BitFormat$(rsF!optRecLevelUndo) & """/>"
  sResult$ = sResult$ & "<autoExecute value=""" & BitFormat$(rsF!optAutoStart) & """/>"
  sResult$ = sResult$ & "<protected value=""" & BitFormat$(rsF!optNoDeleteForm) & """/>"
  sResult$ = sResult$ & "<noSort value=""" & BitFormat$(rsF!optNoSortSubform) & """/>"
  sResult$ = sResult$ & "<readonlyRef value=""" & BitFormat$(rsF!optFastLookup) & """/>"
  sResult$ = sResult$ & "<noMenus value=""" & BitFormat$(rsF!optDisableMenus) & """/>"
  sResult$ = sResult$ & "<noReview value=""" & BitFormat$(rsF!optNoReviewButton) & """/>"
  sResult$ = sResult$ & "<customTitlebar value=""" & BitFormat$(rsF!optDispatch) & """/>"
  sResult$ = sResult$ & "<autoRepeat value=""" & BitFormat$(rsF!optAutoRepeat) & """/>"
  sResult$ = sResult$ & "<subform value=""" & BitFormat$(rsF!optSubformOnly) & """/>"
  If Nz(rsF!formType, 0) And 1 Then
    sResult$ = sResult$ & "<noDelete value=""1""/>"
  Else
    sResult$ = sResult$ & "<noDelete value=""0""/>"
  End If
  If Nz(rsF!formType, 0) And 2 Then
    sResult$ = sResult$ & "<noUpdate value=""1""/>"
  Else
    sResult$ = sResult$ & "<noUpdate value=""0""/>"
  End If
  If Nz(rsF!formType, 0) And 4 Then
    sResult$ = sResult$ & "<noInsert value=""1""/>"
  Else
    sResult$ = sResult$ & "<noInsert value=""0""/>"
  End If
  
  resolution = InStr(LCase$(Nz(rsF!sqlDownloadCriteria)), "order by")
  If resolution > 0 Then
    sResult$ = sResult$ & "<criteria>" & XMLEC$(FixOrderBy$(Mid$(Nz(rsF!sqlDownloadCriteria), resolution, 255), formId&)) & "</criteria>"
  End If
  
  sDefault$ = ""
  If rsF5!column1 > 0 Then
    sDefault$ = sDefault$ & Format(rsF5!column1) & ":" & Format(Nz(rsF5!width1)) & "|"
  End If
  If rsF5!column2 > 0 Then
    sDefault$ = sDefault$ & Format(rsF5!column2) & ":" & Format(Nz(rsF5!width2)) & "|"
  End If
  If rsF5!column3 > 0 Then
    sDefault$ = sDefault$ & Format(rsF5!column3) & ":" & Format(Nz(rsF5!width3)) & "|"
  End If
  
  If sDefault$ <> "" Then
    sDefault$ = Nz(rsF!formName) & "|" & sDefault$
    If rsF5!resetDefaults Then sOverride$ = "1" Else sOverride$ = "0"
    sResult$ = sResult$ & "<defaultSorting value=""" & sDefault$ & """ override=""" & sOverride$ & """/>"
  End If
  If Not IsNull(rsF![passwordString]) Then
    sResult$ = sResult$ & "<password>" & XMLEC$(rsF![passwordString]) & "</password>" & NL$
  End If
  
  effectiveHeight% = 128
  
  While Not rs.EOF
  
    sFormat$ = Format$(rs!formatString)
    
    sResult$ = sResult$ & Format$("<field index=""")
    sResult$ = sResult$ & Nz(rs!questionId) & """>" & NL$
    
    If (rs!optPageBreak) Then
        If rs!questionId > 1 Then
            screenId% = screenId% + 1
        End If
        screenTitle$ = Nz(rs!Caption, formTitle$)
    Else
        If InStr(sFormat$, "K") > 0 Then
            If rs!questionId > 1 Then
                screenId% = screenId% + 1
            End If
        End If
        screenTitle$ = formTitle$
    End If
    
    sResult$ = sResult$ & "<screenId>"
    sResult$ = sResult$ & screenId%
    sResult$ = sResult$ & "</screenId>" & NL$
    
    sResult$ = sResult$ & "<screenTitle>" & sPrefix$
    sResult$ = sResult$ & XMLEC$(screenTitle$)
    sResult$ = sResult$ & sSuffix$ & "</screenTitle>" & NL$
    
    Set rsQ = db.OpenRecordset("select * from question where formId = " & Format$(formId&) & " AND questionId = " & Format$(rs!questionId), dbOpenSnapshot)
    If rsQ.EOF Then
        sResult$ = sResult$ & "<caption></caption>" & NL$
        sResult$ = sResult$ & "<type>4</type>" & NL$
        sResult$ = sResult$ & "<columnName>F" & Format$(rs!questionId) & "</columnName>" & NL$
    Else
        sResult$ = sResult$ & "<caption>" & sPrefix$
        sResult$ = sResult$ & XMLECMBCS$(rsQ!question)
        sResult$ = sResult$ & sSuffix$ & "</caption>" & NL$
    
        sResult$ = sResult$ & "<type>"
        sResult$ = sResult$ & Format$(rsQ!formType)
        sResult$ = sResult$ & "</type>" & NL$
    
        sResult$ = sResult$ & "<columnName>"
        sResult$ = sResult$ & "Q" & Format$(rs!questionId) 'Format$(rsQ!internalName)
        sResult$ = sResult$ & "</columnName>" & NL$
        
        sResult$ = sResult$ & "<fieldKey>"
        sResult$ = sResult$ & Format$(rsQ!fieldKey)
        sResult$ = sResult$ & "</fieldKey>" & NL$
        
        
        sDefault$ = ""
        If Not IsNull(rsQ![defaultValue]) Then
          Select Case Nz(rsQ![formType])
          Case formCustom
            sDefault$ = Left$(NLToCR$(rsQ![defaultValue]), 31)
          Case formText, formLookup, formExclusiveLookup, formNumeric, formOption, formVAS, formROText, formCustomControl
            sDefault$ = rsQ![defaultValue]
          Case formPopup
            sDefault$ = Nz(rsQ!defaultValue)
          Case formCurrency
            sDefault$ = Format$(CDbl(CCur(rsQ![defaultValue])), "@")
          Case formMultiSelect
            sDefault$ = Format$(popupIndices(formId, rsQ!questionId, Nz(rsQ!defaultValue)), "@")
          Case formDate, formDateOnly, formTimeStamp
            If DateValue(Nz(rsQ!defaultValue)) >= DateSerial(1970, 1, 1) Then
              sDefault$ = Format$(rsQ!defaultValue, "yyyy-mm-dd Hh:Nn:Ss")
            End If
          Case formYNOption, formCompleteCheck
            sDefault$ = Left$(UCase$(Nz(rsQ!defaultValue)), 1)
          End Select
          
        End If
        
        sResult$ = sResult$ & "<defaultValue>" & sPrefix$
        sResult$ = sResult$ & XMLEC$(sDefault$)
        sResult$ = sResult$ & sSuffix$ & "</defaultValue>" & NL$
        
        sResult$ = sResult$ & "<patternText>"
        sResult$ = sResult$ & Nz(rsQ!patternText)
        sResult$ = sResult$ & "</patternText>" & NL$
        
        sResult$ = sResult$ & "<fieldHidden>"
        sResult$ = sResult$ & Format$(rsQ!fieldHidden)
        sResult$ = sResult$ & "</fieldHidden>" & NL$
        
        sResult$ = sResult$ & "<fieldReadOnly>"
        sResult$ = sResult$ & Format$(rsQ!fieldReadOnly)
        sResult$ = sResult$ & "</fieldReadOnly>" & NL$
        
        sResult$ = sResult$ & "<fieldAutodefault>"
        sResult$ = sResult$ & Format$(rsQ!fieldAutodefault)
        sResult$ = sResult$ & "</fieldAutodefault>" & NL$
        
        sResult$ = sResult$ & "<fieldRequired>"
        sResult$ = sResult$ & Format$(rsQ!fieldRequired)
        sResult$ = sResult$ & "</fieldRequired>" & NL$
        
        sResult$ = sResult$ & "<rangeValue>"
        sResult$ = sResult$ & Nz(rsQ!rangeValue)
        sResult$ = sResult$ & "</rangeValue>" & NL$
        
        sResult$ = sResult$ & "<lookupListName>" & sPrefix$
        sResult$ = sResult$ & XMLEC$(Nz(rsQ!lookupListName))
        sResult$ = sResult$ & sSuffix$ & "</lookupListName>" & NL$
        
        sResult$ = sResult$ & "<maxValue>"
        sResult$ = sResult$ & Nz(rsQ!maxValue)
        sResult$ = sResult$ & "</maxValue>" & NL$
        
        sResult$ = sResult$ & "<minValue>"
        sResult$ = sResult$ & Nz(rsQ!minValue)
        sResult$ = sResult$ & "</minValue>" & NL$
        
        sResult$ = sResult$ & "<fieldPrimary>"
        sResult$ = sResult$ & Format$(rsQ!fieldPrimary)
        sResult$ = sResult$ & "</fieldPrimary>" & NL$
        
        sResult$ = sResult$ & "<fieldNoUpdates>"
        sResult$ = sResult$ & Format$(rsQ!fieldNoUpdates)
        sResult$ = sResult$ & "</fieldNoUpdates>" & NL$
        
        sResult$ = sResult$ & "<fieldNonPrinting>"
        sResult$ = sResult$ & Format$(rsQ!fieldNonPrinting)
        sResult$ = sResult$ & "</fieldNonPrinting>" & NL$
        
        sResult$ = sResult$ & "<scriptVariable>" & sPrefix$
        sResult$ = sResult$ & XMLEC$(Format$(rsQ!scriptVariable))
        sResult$ = sResult$ & sSuffix$ & "</scriptVariable>" & NL$
        
        If Not IsNull(rsQ!questionScript) Then
            eQS$ = ""
            bQS$ = ""
            If DLLValidateScriptPPC(UncommentedScript$(ConvertedScriptDB$(Nz(rsQ!questionScript), rsQ!formId), True), eQS$, bQS$) >= 0 Then
                'sResult$ = sResult$ & "<questionScript>" & sPrefix$
                'sResult$ = sResult$ & XMLEC$(UncommentedScript$(ConvertedScriptDB$(Nz(rsQ!questionScript), rsQ!formId), True))
                'sResult$ = sResult$ & sSuffix$ & "</questionScript>" & NL$
                sResult$ = sResult$ & "<questionScriptCode>" & sPrefix$
                sResult$ = sResult$ & bQS$
                sResult$ = sResult$ & sSuffix$ & "</questionScriptCode>" & NL$
            Else
              If MsgBox("The script in field " & rsQ!questionId & " did not compile:  " & eQS$ & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "The form could not be updated for distribution.", vbOKOnly + vbExclamation, "Form Distribution Problem") = vbOK Then
              End If
              FormatSyncXML$ = ""
              Exit Function
            End If
        End If
        
        If IsNull(rsQ!popupOptions) Then
        Else
            Select Case rsQ!formType
            Case formPopup, formJumpPopup, formSubform, formMultiSelect, formSingleSubform
                sTail$ = Nz(rsQ!popupOptions)
                sHead$ = HeadLine$(sTail$)
                sTail$ = TailLines$(sTail$)
                sResult$ = sResult$ & "<elements>"
                'wPopupIndex% = 1
                While sHead$ <> ""
                    sResult$ = sResult$ & "<element>" & sPrefix$
                    sResult$ = sResult$ & XMLECMBCS$(sHead$)
                    sResult$ = sResult$ & sSuffix$ & "</element>" & NL$
                    sHead$ = HeadLine$(sTail$)
                    sTail$ = TailLines$(sTail$)
                    'wPopupIndex% = wPopupIndex% + 1
                Wend
                sResult$ = sResult$ & "</elements>" & NL$
            Case Else
                sResult$ = sResult$ & "<popupOptions>" & sPrefix$
                sResult$ = sResult$ & XMLEC$(Nz(rsQ![popupOptions]))
                sResult$ = sResult$ & sSuffix$ & "</popupOptions>" & NL$
            End Select
        End If
    End If
    rsQ.Close
    
    sResult$ = sResult$ & "<labelcolor>"
    If IsNull(rs!questionColor) Then
      sResult$ = sResult$ & "0"
    Else
      sResult$ = sResult$ & Format$(rs!questionColor)
    End If
    sResult$ = sResult$ & "</labelcolor>" & NL$
    
    sResult$ = sResult$ & "<labelfont>"
    sResult$ = sResult$ & Format$(rs!questionFont)
    sResult$ = sResult$ & "</labelfont>" & NL$
    
    sResult$ = sResult$ & "<color>"
    If IsNull(rs!questionColor) Then
      sResult$ = sResult$ & "0"
    Else
      sResult$ = sResult$ & Format$(rs!answerColor)
    End If
    sResult$ = sResult$ & "</color>" & NL$
    
    sResult$ = sResult$ & "<font>"
    sResult$ = sResult$ & Format$(rs!answerFont)
    sResult$ = sResult$ & "</font>" & NL$
    
    sResult$ = sResult$ & "<coordinates context=""label"">" & NL$
    
    If computeXY Then
        sResult$ = sResult$ & "<left>" & Format$(0) & "</left>" & NL$
        sResult$ = sResult$ & "<top>" & Format$(computedTop%) & "</top>" & NL$
        sResult$ = sResult$ & "<width>" & Format$(240) & "</width>" & NL$
        sResult$ = sResult$ & "<height>" & Format$(Y%) & "</height>" & NL$
        computedTop% = computedTop% + Y%
    Else
        sResult$ = sResult$ & "<left>" & Format$(rs!questionX) & "</left>" & NL$
        sResult$ = sResult$ & "<top>" & Format$(rs!questionY) & "</top>" & NL$
        sResult$ = sResult$ & "<width>" & Format$(rs!questionWidth) & "</width>" & NL$
        sResult$ = sResult$ & "<height>" & Format$(rs!questionHeight) & "</height>" & NL$
    End If
    
    sResult$ = sResult$ & "</coordinates>" & NL$
    
    sResult$ = sResult$ & "<formatString>"
    sResult$ = sResult$ & Nz(rs!formatString, "")
    sResult$ = sResult$ & "</formatString>" & NL$
    
    flags& = 0
    If rs!optPageBreak Then
      flags& = flags& Or &H1
    End If
    
    If InStr(sFormat$, "K") > 0 Then
      flags& = flags& Or &H1
    End If
    
    If rs!optKeypad Then
      flags& = flags& Or &H2
    End If
    
    If rs!optKeypadIcon Then
      flags& = flags& Or &H4
    End If
    
    If rs!optNoFocus Then
      flags& = flags& Or &H8
    End If
    
    If rs!optImageHiRes Then
      flags& = flags& Or &H100
    End If
    
    If rs!optImageInline Then
      flags& = flags& Or &H40
    End If
    
    If rs!optCaptionHiRes Then
      flags& = flags& Or &H80
    End If
    
    If InStr(sFormat$, "Y") > 0 Then
      flags& = flags& Or &H40
    End If
    
    If InStr(sFormat$, "I") > 0 Then
      flags& = flags& Or &H200
    End If
    
    If InStr(sFormat$, "R") > 0 Then
      flags& = flags& Or &H400
    End If
    
    If InStr(sFormat$, "C") > 0 Then
      flags& = flags& Or &H800
    End If
    
    If InStr(sFormat$, "N") > 0 Then
      flags& = flags& Or &H1000
    End If
    
    If InStr(sFormat$, "3") > 0 Then
      flags& = flags& Or &H800
    End If
    
    If InStr(sFormat$, "6") > 0 Then
      flags& = flags& Or &H1000
    End If
    
    sResult$ = sResult$ & "<flags>"
    sResult$ = sResult$ & Format$(flags&)
    sResult$ = sResult$ & "</flags>" & NL$
    
    sResult$ = sResult$ & "<coordinates context=""field"">" & NL$
    
    If computeXY Then
        sResult$ = sResult$ & "<left>" & Format$(0) & "</left>" & NL$
        sResult$ = sResult$ & "<top>" & Format$(computedTop%) & "</top>" & NL$
        sResult$ = sResult$ & "<width>" & Format$(240) & "</width>" & NL$
        sResult$ = sResult$ & "<height>" & Format$(Y%) & "</height>" & NL$
        computedTop% = computedTop% + Y%
    Else
        sResult$ = sResult$ & "<left>" & Format$(rs!answerX) & "</left>" & NL$
        sResult$ = sResult$ & "<top>" & Format$(rs!answerY) & "</top>" & NL$
        sResult$ = sResult$ & "<width>" & Format$(rs!answerWidth) & "</width>" & NL$
        sResult$ = sResult$ & "<height>" & Format$(rs!answerHeight) & "</height>" & NL$
    End If
    
    sResult$ = sResult$ & "</coordinates>" & NL$
    
    
    If Not IsNull(rs!screenGraphic) Then
      sFormat$ = "F" & Format$(formId&) & "Q" & Format$(rs!questionId) & ".bmp"
      sResult$ = sResult$ & "<screenGraphic>" & sFormat$ & "</screenGraphic>" & NL$
      sNewImage$ = Space$(Len(rs!screenGraphic) * 9 + 8192)
      sOldImage$ = rs!screenGraphic
      If rs!optCaptionHiRes Then
        resolution = 1
      Else
        resolution = 0
      End If
      
      yoffset = rs!questionY
      sourceLen = Len(sOldImage$)
      destLen = 0
      destLen = ImageResize(sOldImage$, sourceLen, sNewImage$, resolution, yoffset)
      sNewImage$ = Left$(sNewImage$, destLen)
      sResult$ = sResult$ & "<image>" & sNewImage$ & "</image>" & NL$ 'rs!screenGraphic
      'StoreGraphicFile sFormat$, sFileDirectory$, rs!screenGraphic
    End If
    
    sResult$ = sResult$ & "</field>" & NL$
    rs.MoveNext
    
  Wend
  
  FormatSyncXML$ = sResult$ & "</form>" & NL$
  
End Function
 
Laatst bewerkt:
Bartje heb het al zelf gefixed :D:D wat ben ik toch goed :shocked::D
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan