Copy formatted values and paste as text-CodePudding

I have a database in Excel, which I use for creating a serial letter in Word via VBA. Now there is following issue:

When I import the data in Word manually (Excel-sheet is closed), everything works fine. The formatted values (e.g. " - 1K", "1000 °C", "36:00", "17.11.2021") are imported as text and shown in the serial letter. Excel database and Word serial letter formatted
When I import the data in Word manually (Excel-sheet is opened), only the values are imported and the format is discraded (e.g. "1", "1000", "1.5", "44517"). Additionally, they are imported as text and, hence, cannot be formatted via mailmerge functions (e.g. "@ "dd.MM.yyyy""). Word serial letter unformatted
When I push the data from Excel into Word automatically via VBA (Excel-sheet is obviously opened), the problem is similar. (following code is probably not relevant)

    'die Anzahl der Positionen defininieren
    Dim n           As Long
    n = Worksheets("Eingabemaske").Range("BX2").Value   1        'Zeilen aus der Anzahl der Positionen bestimmen
    
    'Nach Sachbearbeiter den LS (x bzw. y auswählen)
    Dim Bearbeiterstandort As String
    Bearbeiterstandort = Application.International(xlDecimalSeparator)
    If InStr(Bearbeiterstandort, ".") > 0 Then
        strSerienbrief1 = "Sinterauftrag PUNKT"
    ElseIf InStr(Bearbeiterstandort, ",") > 0 Then
        strSerienbrief1 = "Sinterauftrag KOMMA"
    Else
        MsgBox "Support kontaktieren"
    End If
    
    'Serienbrief1
    
    strLaufwerkDateiname = ThisWorkbook.Path & "\Serienbriefvorlagen\" & strSerienbrief1 & ".docx"        'Pfad und Dateinamen zusammenfügen
    Set oWord = CreateObject("word.application")
    Set oDoc = oWord.Documents.Open(strLaufwerkDateiname)
    oWord.Visible = True
    oWord.Application.Activate        'Dokument wird in den Vordergrund geholt
    
    oDoc.MailMerge.MainDocumentType = 0        'wdFormLetters = 0. Gibt einen Typ von Seriendruckdokument an.
    oDoc.MailMerge.OpenDataSource Name:= _
                                  ThisWorkbook.FullName _
                                  , ConfirmConversions:=False, LinkToSource:=True, Connection:= _
                                  "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & _
                                  ThisWorkbook.FullName & _
                                  ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Je" _
                                  , SQLStatement:="SELECT * FROM `Eingabemaske$`", SQLStatement1:="", SubType:=1        'hier das Blatt ändern
    With oDoc.MailMerge
        .Destination = 0        'wdSendToNewDocument  = 0. Die Ergebnisse werden aus dem Serienbrief in ein neues Dokument übertragen.
        .SuppressBlankLines = True        'Wenn Seriendruckfelder leer sind, werden die leere Zeilen im Seriendruckdokument unterdrückt.
        With .DataSource
            .FirstRecord = 1        'wdDefaultFirstRecord = 1. Aus dem Hauptdokument mit den Datensätzen 1 bis
            .LastRecord = n        'wdDefaultLastRecord = -16. Zum letzten Datensatz zusammengeführt
        End With
        .Execute Pause:=False
    End With
    oDoc.Close SaveChanges:=0        'Das Seriendruckdokument wird ohne Speichern geschlossen
    
    'Word Datei abspeichern
    Dim dateiname   As String
    strLaufwerkDateiname2 = ThisWorkbook.Path & "\"        'Speicherpfad
    teil1 = oWord.ActiveDocument.Words(1).Start        'Dateiname Start
    teil2 = oWord.ActiveDocument.Words(2).End        'Dateiname Ende
    dateiname = oWord.ActiveDocument.Range(teil1, teil2).Text        'Dateiname zusammensetzen
    oWord.ActiveDocument.ExportAsFixedFormat outputfilename:=strLaufwerkDateiname2 & dateiname & ".pdf", exportformat:=wdExportFormatPDF        'PDF abspeichern
    oWord.ActiveDocument.SaveAs2 Filename:=strLaufwerkDateiname2 & dateiname & ".docx"        'Word abspeichern
    oWord.ActiveDocument.Close        'Datei schliessen
    oWord.Application.Quit        'Word schliessen
    
    Set oDoc = Nothing        'Dimension zurücksetzen
    Set oWord = Nothing

When the values are written as text (e.g. "' - 1K", "'1000 °C", "'36:00", "'17.11.2021") the problem is solved.

Now I would like ask you for a quick way to copy a formated value (so " - 1 K" and not just "1") from cell A1 and insert the formatted value as text to A2. I tried

    Sheets("Eingabemaske").Range("b2:DA51") = Range("c52:Db102").Worksheet.Evaluate("index(text(B2:DA51,""'""),)")

but the result are just empty cells with "'" inserted.

The function

Range("K2").Value = Format(Range("J2"), "&")

only copies the value but maintains the format of the goal cell.

Does anybody have an idea how to import the formated values into a serial letter as text when excel is opened or how to replace all formatted values for a text with the same format?

CodePudding user response：

You can accomplish what you need as follows:

Make a VBA function that returns the number format:

Public Function GetCellNumberFormat(R As Range) As String

    GetCellNumberFormat = R.NumberFormat
    
End Function

For each value you want to retrieve, create a second cell with a formula that explicitly converts the value to a text using the same formatting:

=TEXT(B3;PERSONAL.XLSB!GetCellNumberFormat(B3))

The result in the new cell will look the same as cell B3 in this example, but it will be text and not just a number.

Use the value from the new cell when you import to your Word letter.

You can also use the new function directly in VBA and get its formatted text by using the worksheet function like this:

Application.WorksheetFunction.Text(R.Value, GetCellNumberFormat(R))

where R is a Range variable of a cell.

CodePudding user response：

A decades-old trick to saving numbers as text is real easy. I would imagine it saves processing time in long loops since no function is actually called.

Range("A2") = "'" & Range("B2")