Suche | Statistiken | Benutzerliste | Access-FAQ | Datenschutz Foren
donkarl Forum
donkarl Forum ->  Themen -> Access -> Diskussion ansehen

Du bist als Gast eingelogt. ( Anmelden | Registrieren )
  • Access Stammtisch München am 09.11.2023 (Do)
  • StefanWirrer07.11.23 16:24
  • Access 2021 - Phänomen
  • Parvus03.11.23 17:30
       └ RE: Access 2021 - Phänomen PeterDoering03.11.23 19:01
          └ RE: Access 2021 - Phänomen Parvus03.11.23 19:54
             └ RE: Access 2021 - Phänomen PeterDoering04.11.23 10:12
  • Ergebnis aus RunSQL in einem Feld anzeigen
  • Paula20.10.23 18:25
       └ RE: Ergebnis aus RunSQL in einem Feld anzeigen Paula21.10.23 20:31
       └ RE: Ergebnis aus RunSQL in einem Feld anzeigen Karl Donaubauer25.10.23 23:46
          └ RE: Ergebnis aus RunSQL in einem Feld anzeigen Paula26.10.23 12:15
  • Herkunft verknüpfter Tabellen auflisten
  • drnicolas17.10.23 13:34
       └ RE: Herkunft verknüpfter Tabellen auflisten StefanWirrer19.10.23 09:58
  • Problem beim Zugriff auf externe SQL-Tabellen (tim...
  • drnicolas17.10.23 13:28
  • Command-Funktion Access 2013
  • BMAJ15.12.21 08:48
       └ RE: Command-Funktion Access 2013 PeterDoering05.01.22 14:47
          └ RE: Command-Funktion Access 2013 BMAJ11.01.22 12:15
             └ RE: Command-Funktion Access 2013 PeterDoering11.01.22 22:01
                └ RE: Command-Funktion Access 2013 BMAJ09.12.22 11:51
                   └ RE: Command-Funktion Access 2013 Karl Donaubauer09.12.22 12:33
                      └ RE: Command-Funktion Access 2013 BMAJ11.10.23 12:29
  • Access Stammtisch München am 12.10.2023 (Do)
  • StefanWirrer10.10.23 09:14
  • Formular wechseln
  • rutmay25.09.23 17:27
       └ RE: Formular wechseln Karl Donaubauer25.09.23 17:41
          └ RE: Formular wechseln rutmay26.09.23 22:25
  • Scrollen über mehrere Unterformulare
  • Andrea17.08.23 16:57
       └ RE: Scrollen über mehrere Unterformulare Andrea22.08.23 13:30
          └ RE: Scrollen über mehrere Unterformulare Karl Donaubauer22.08.23 16:45
             └ RE: Scrollen über mehrere Unterformulare Andrea29.08.23 13:33
                └ RE: Scrollen über mehrere Unterformulare Karl Donaubauer29.08.23 14:52
  • Einladung zum 13. virtuellen Access-Stammtisch Han...
  • KlausWerther15.08.23 14:37
  • Access Stammtisch München am 10.08.2023 (Do)
  • StefanWirrer08.08.23 09:41
  • Copy and Past via VBA Code
  • Wasser202302.08.23 17:30
       └ RE: Copy and Past via VBA Code Gunter Avenius04.08.23 18:02
  • Access 2003: Wie xls-Tabelle aktualisieren?
  • Rainer Flemming19.06.23 18:41
       └ RE: Access 2003: Wie xls-Tabelle aktualisieren? Karl Donaubauer20.06.23 11:22
          └ RE: Access 2003: Wie xls-Tabelle aktualisieren? Rainer Flemming21.06.23 10:40
             └ RE: Access 2003: Wie xls-Tabelle aktualisieren? Karl Donaubauer27.06.23 17:55
                └ RE: Access 2003: Wie xls-Tabelle aktualisi... Rainer Flemming21.07.23 15:11
  • Access Stammtisch München am 13.07.2023 (Do)
  • StefanWirrer11.07.23 12:38
  • Access Stammtisch München am 15.06.2023 (Do)
  • StefanWirrer13.06.23 14:11
    Gunter Avenius
    Gesendet: 04.08.23 18:02
    Betreff: RE: Copy and Past via VBA Code



    Regular

    Beiträge: 66
    2525
    Ort: Röthenbach a.d.Peg.
    Hallo,

    folgender Code in ein Standard Modul kopieren und anschließend die Funktion Translation aufrufen.

    Gruß
    Gunter

    Option Compare Database
    Option Explicit

    '***App Window Constants***
    Public Const WIN_NORMAL = 1 'Open Normal
    Public Const WIN_MAX = 3 'Open Maximized
    Public Const WIN_MIN = 2 'Open Minimized

    '***Error Codes***
    Private Const ERROR_SUCCESS = 32&
    Private Const ERROR_NO_ASSOC = 31&
    Private Const ERROR_OUT_OF_MEM = 0&
    Private Const ERROR_FILE_NOT_FOUND = 2&
    Private Const ERROR_PATH_NOT_FOUND = 3&
    Private Const ERROR_BAD_FORMAT = 11&

    Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

    Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (dest As Any, source As Any, _
    ByVal bytes As Long)

    Public Function Translation()
    Dim strString As String
    Dim bolLanguageTranslation As Boolean


    bolLanguageTranslation = True

    strString = "Der Text der übersetzt werden soll"

    If Len(Trim(Replace(strString, vbCrLf, " "))) > 0 Then

    Dim strUTF8 As String
    strUTF8 = GetEncodedUTF8String(strString)

    Dim strTrans As String

    If bolLanguageTranslation = False Then 'EN
    strTrans = "https://translate.google.de/?hl&ie=UTF-8&sl=en&tl=de&text=" & strUTF8 & "&op=translate"

    fHandleFile strTrans, WIN_NORMAL
    Else 'DE
    strTrans = "https://translate.google.de/?h=&ie=UTF-8&sl=de&tl=en&text=" & strUTF8 & "&op=translate"
    fHandleFile strTrans, WIN_NORMAL
    End If

    End If

    End Function


    '***************Usage Examples***********************
    'Open a folder: ?fHandleFile("C:\TEMP\",WIN_NORMAL)
    'Call Email app: ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
    'Open URL: ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
    'Handle Unknown extensions (call Open With Dialog):
    ' ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
    'Start Access instance:
    ' ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
    '****************************************************

    Function fHandleFile(stFile As String, lShowHow As Long)
    Dim lRet As Long, varTaskID As Variant
    Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
    stFile, vbNullString, vbNullString, lShowHow)

    If lRet > ERROR_SUCCESS Then
    stRet = vbNullString
    lRet = -1
    Else
    Select Case lRet
    Case ERROR_NO_ASSOC:
    'Try the OpenWith dialog
    varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
    & stFile, WIN_NORMAL)
    lRet = (varTaskID <> 0)
    Case ERROR_OUT_OF_MEM:
    stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
    Case ERROR_FILE_NOT_FOUND:
    stRet = "Error: File not found. Couldn't Execute!"
    Case ERROR_PATH_NOT_FOUND:
    stRet = "Error: Path not found. Couldn't Execute!"
    Case ERROR_BAD_FORMAT:
    stRet = "Error: Bad File Format. Couldn't Execute!"
    Case Else:
    End Select
    End If
    fHandleFile = lRet & _
    IIf(stRet = "", vbNullString, ", " & stRet)
    End Function


    Public Function GetEncodedUTF8String( _
    ByVal Text As String _
    ) As String

    Dim Index1 As Long
    Dim Index2 As Long
    Dim Result As String
    Dim Chars() As Byte
    Dim Char As String
    Dim Byte1 As Byte
    Dim Byte2 As Byte
    Dim UTF16 As Long

    For Index1 = 1 To Len(Text)
    CopyMemory Byte1, ByVal StrPtr(Text) + ((Index1 - 1) * 2), 1
    CopyMemory Byte2, ByVal StrPtr(Text) + ((Index1 - 1) * 2) + 1, 1
    UTF16 = Byte2
    UTF16 = UTF16 * 256 + Byte1
    Chars = GetUTF8FromUTF16(UTF16)
    For Index2 = LBound(Chars) To UBound(Chars)
    Char = Chr(Chars(Index2))
    If Char Like "[0-9A-Za-z]" Then
    Result = Result & Char
    Else
    Result = Result & "%" & Hex(Asc(Char))
    End If
    Next
    Next

    GetEncodedUTF8String = Result

    End Function

    Public Function GetUTF8FromUTF16( _
    ByVal UTF16 As Long _
    ) As Byte()

    Dim Result() As Byte

    If UTF16 < &H80 Then
    ReDim Result(0 To 0)
    Result(0) = UTF16
    ElseIf UTF16 < &H800 Then
    ReDim Result(0 To 1)
    Result(1) = &H80 + (UTF16 And &H3F)
    UTF16 = UTF16 \ &H40
    Result(0) = &HC0 + (UTF16 And &H1F)
    Else
    ReDim Result(0 To 2)
    Result(2) = &H80 + (UTF16 And &H3F)
    UTF16 = UTF16 \ &H40
    Result(1) = &H80 + (UTF16 And &H3F)
    UTF16 = UTF16 \ &H40
    Result(0) = &HE0 + (UTF16 And &HF)
    End If
    GetUTF8FromUTF16 = Result

    End Function

    -----
    Gruß
    Gunter
    --

    Access FAQ: http://www.donkarl.com

    http://www.avenius.de - http://www.AccessRibbon.de
    http://www.ribboncreator.de - http://www.ribboncreator2010.de
    http://www.ribboncreator2016.de - http://www.ribboncreator2019.de
    Top of the page Bottom of the page


    Seite: < 1 2 3 4 5 6 7 8 9 10 ... >
    Suche in diesem Forum
    Druckfreundliche Version
    (Alle Cookies von dieser Seite löschen.)