Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

[DocAElstein]

test


https://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page52
Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs




Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range(”A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occurred" }
finally { $excel .Quit() } # this section will be done if an error occurs

[DocAElstein]

test


https://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page52
Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs




Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range(”A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occurred" }
finally { $excel .Quit() } # this section will be done if an error occurs

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776




'In support of these forum posts
'https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
'https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
'https://eileenslounge.com/viewtopic.php?f=18&t=37740
'https://eileenslounge.com/viewtopic.php?f=18&t=37712
'https://eileenslounge.com/viewtopic.php?f=18&t=37707


Sub Services2() ' https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776 https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
' kill the text file before I make it, because the code might otherwise use a previous one, as it takes a second or so to overwrite the old or make a new one
Do While Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) <> ""
If Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) <> "" Then Kill PathName:="" & ThisWorkbook.Path & Application.PathSeparator & "test.txt"
Application.Wait (Now + TimeValue("0:00:01"))
Loop
DoEvents: DoEvents
' Application.Wait (Now + TimeValue("0:00:01")) ' I am not sure why I had to do this. It should not be necerssary, without it the text file is empty - maybe Dir says something is there before it is available to have???
' PowerShell
Dim PScmdLet As String, cmdLet As String
'Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\acer\Desktop\test.txt' -Width 1000"
Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath '" & ThisWorkbook.Path & Application.PathSeparator & "test.txt' -Width 2000"
Let PScmdLet = "powershell -command " & cmdLet ' https://www.devhut.net/vba-run-powershell-command/
CreateObject("WScript.Shell").Exec (PScmdLet)
' we need to wait a bit until the text file is made
Do While Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) = ""
Application.Wait (Now + TimeValue("0:00:01"))
Loop
DoEvents: DoEvents ' I chucked this in, but did not really have any reason
Application.Wait (Now + TimeValue("0:00:02")) ' I am not sure why I had to do this. It should not be necerssary, without it the text file is empty - maybe Dir says something is there before it is available to have??? 01 seemed OK - I made it 2
' Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "test.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
Get #FileNum, , TotalFile 'Debug.Print TotalFile
Let TotalFile = Replace(TotalFile, Chr(0), "", 1, -1, vbBinaryCompare) ' There seems to be a lot of Chr(0)s in the string https://i.postimg.cc/t43HCQr9/Rather-a-lot-of-Chr-0-s.jpg
'Let TotalFile = Replace(TotalFile, Chr(255) & Chr(254) & vbCr & vbLf, "", 1, 1, vbBinaryCompare) ' this would tsake the first bit of crap out, (alternatively we can just take out the first line when split later by
Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)

' make a 1 D array of the text file lines
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)

' make array for output
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrRws()) - 2, 1 To 3) ' we are ignoring the first 3 lines. The UBound of the 1 dimensional array is already 1 less then the lines we need because a 1 dimensional array starts at 0
Dim Cnt As Long
For Cnt = 1 To UBound(arrRws()) - 2
If arrRws(Cnt + 2) = "" Then
' This should occur at the last empty rows, so we could consider jumping out of the loop here
Else
' This is a bit of a temporary bodge as the Display name sometimes pushes up to the startuptype which screws up the string manipulation below
Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Manual", " Manual", 1, 1, vbBinaryCompare): Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Automatic", " Auotomatic", 1, 1, vbBinaryCompare): Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Disabled", " Disabled", 1, 1, vbBinaryCompare)
' time to split the line string
Dim Pos1 As Long: Let Pos1 = InStr(1, arrRws(Cnt + 2), " ", vbBinaryCompare)
Dim Nme As String: Let Nme = Left(arrRws(Cnt + 2), Pos1 - 1)
Dim Pos3 As Long: Let Pos3 = Len(arrRws(Cnt + 2)) - InStrRev(arrRws(Cnt + 2), " ", -1, vbBinaryCompare)
Dim StrtTyp As String: Let StrtTyp = Right(arrRws(Cnt + 2), Pos3)
Dim DispNme As String: Let DispNme = Replace(arrRws(Cnt + 2), Nme, "", 1, 1, vbBinaryCompare)
Let DispNme = Replace(DispNme, StrtTyp, "", 1, 1, vbBinaryCompare)
Let DispNme = Trim(DispNme)
' fill the array for output
Let arrOut(Cnt, 1) = Nme: arrOut(Cnt, 2) = DispNme: arrOut(Cnt, 3) = StrtTyp
End If

Next Cnt

' Chuck array into a spreadsheet
Let ThisWorkbook.Worksheets("PowerShell").Range("A2").Resize(UBound(arrOut(), 1), 3).Value = arrOut()
ThisWorkbook.Worksheets("PowerShell").Cells.Columns("A:C").EntireColumn.AutoFit

End Sub

[DocAElstein]

test


https://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page52
Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs




Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range(”A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occurred" }
finally { $excel .Quit() } # this section will be done if an error occurs

[DocAElstein]

test


https://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page52
Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs




Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occured" } ; finally {$excel.Quit() } # this section will be done if an error occurs





Remove-Variable * -ErrorAction SilentlyContinue # This is very helpful when developing and debuging skript in the ISE, because the ISE has a habit of maintaining variables values between script executions, so this is needed, or else a removed variable may still be there - when fucking about with variables, this can get you in a very frustrating mess. In technical terms: By default variables are persistant. https://pscustomobject.github.io/powershell/howto/PowerShell-ISE-Clear-Variables/
# https://eileenslounge.com/viewtopic.php?t=33011&sid=726de7ffbd0c03680b62280fd86753e0
# Path I have used for my text file output 'C:\Users\Admin\Desktop\test.txt' here full line Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\Admin\Desktop\test.txt' -Width 2000
# and for Excel example file C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls

try # Most of the main coding is in a try section ================================================== ============================
{[object]$excel = New-Object -ComObject Excel.Application # https://www.youtube.com/watch?v=xc8A7Z0JLB0&t=995s
$excel.Visible = $true
[string]$excelPath = "C:\Users\Admin\Desktop\PowerShellAshishRajFeedback .xls"
$excelWB = $excel.workbooks.Open($excelPath)
# Worksheets info
$excelWS=$excelWB.WorkSheets.item("AshishRajCOM")
$excelWS.Activate() # It seems that in PowerShell script an extra () is needed
$excelWS.Cells.Item(1, 1).Value = "name" ; $excelWS.Cells.Item(1, 2).Value = "displayname" ; $excelWS.Cells.Item(1, 3).Value = "starttype"
# write in service
[int]$rowWS = 2
ForEach($Service in Get-Service) { $excelWS.Cells.Item($rowWS, 1).Value = $Service.Name.ToString() ; $excelWS.Cells.Item($rowWS, 2).Value = $Service.DisplayName.ToString() ; $excelWS.Cells.Item($rowWS, 3).Value = $Service.StartType.ToString()
If($Service.Status -eq "Running") { $excelWS.Cells.Item($rowWS, 1).Range(”A1:C1").Font.ColorIndex = 10 }
elseif($Service.Status -eq "Stopped") { $excelWS.Cells.Item($rowWS, 1).Range("A1:C1").Font.ColorIndex = 3 }
$rowWS++ }
$excelWS.Cells.Columns("A:C").EntireColumn.AutoFit() # Tidy up column widths
# $excelWB.SaveAs($excelPath)
$excelWB.Save() # It seems that in PowerShell script an extra () is needed
$excel.Quit() } # ================================================== ================================================== =========
catch { Write-Host "some error occurred" }
finally { $excel .Quit() } # this section will be done if an error occurs

[DocAElstein]

<div class="gmail_chip gmail_drive_chip">
<div class="gmail_chip gmail_drive_chip">
<p style="margin: 0px;"><span style="font-family: arial,helvetica,sans-serif; font-size: 10pt; color: #000000; text-decoration: none;"><a href="https://www.youtube.com/watch?v=5ckOWXGDL34&amp;lc=UgyqZfLMydnVuNbtqTR4AaABAg. 9ZBy1PrRmM89ZEE6b4w03-">https://www.youtube.com/watch?v=5ckOWXGDL34&amp;lc=UgyqZfLMydnVuNbtqTR4AaABAg. 9ZBy1PrRmM89ZEE6b4w03-</a> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 7<br /></span></p>
<p style="margin: 0px;"><span style="font-family: arial,helvetica,sans-serif; font-size: 10pt; color: #000000; text-decoration: none;">https://www.youtube.com/watch?v=5ckOWXGDL34&amp;lc=UgzW4-G9Rh2o5ljabrV4AaABAg</span> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 13&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</p>
</div>

[DocAElstein]

In support of this post https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12782
Security tweaks

# Will like XP or Win7 Disable Windows Defender Disable Defender Updates Set UAC to Never Prompt Disable Meltdown Flag Disable Windows Malware Scan
$securitylow.Add_Click({
Write-Host "Lowering UAC level..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "ConsentPromptBehaviorAdmin" -Type DWord -Value 0
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "PromptOnSecureDesktop" -Type DWord -Value 0
Write-Host "Disabling Windows Defender..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Force | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Name "DisableAntiSpyware" -Type DWord -Value 1
If ([System.Environment]::OSVersion.Version.Build -eq 14393) {
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "WindowsDefender" -ErrorAction SilentlyContinue
} ElseIf ([System.Environment]::OSVersion.Version.Build -ge 15063) {
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "SecurityHealth" -ErrorAction SilentlyContinue
}
Write-Host "Disabling Windows Defender Cloud..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Force | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SpynetReporting" -Type DWord -Value 0
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SubmitSamplesConsent" -Type DWord -Value 2
Write-Host "Disabling Meltdown (CVE-2017-5754) compatibility flag..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" -Name "cadca5fe-87d3-4b96-b7fb-a231484277cc" -ErrorAction SilentlyContinue
Write-Host "Disabling Malicious Software Removal Tool offering..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" -Name "DontOfferThroughWUAU" -Type DWord -Value 1
$wshell.Popup("Operation Completed",0,"Done",0x0)
})


# Enable Windows Malware Scan Enable Meltdown Flag Disable Windows Defender Set UAC to Always Prompt Disable Defender Updates
$securityhigh.Add_Click({
Write-Host "Raising UAC level..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "ConsentPromptBehaviorAdmin" -Type DWord -Value 5
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "PromptOnSecureDesktop" -Type DWord -Value 1
Write-Host "Disabling SMB 1.0 protocol..."
Set-SmbServerConfiguration -EnableSMB1Protocol $false -Force
Write-Host "Enabling Windows Defender..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Name "DisableAntiSpyware" -ErrorAction SilentlyContinue
If ([System.Environment]::OSVersion.Version.Build -eq 14393) {
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "WindowsDefender" -Type ExpandString -Value "`"%ProgramFiles%\Windows Defender\MSASCuiL.exe`""
} ElseIf ([System.Environment]::OSVersion.Version.Build -ge 15063) {
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "SecurityHealth" -Type ExpandString -Value "`"%ProgramFiles%\Windows Defender\MSASCuiL.exe`""
}
Write-Host "Enabling Windows Defender Cloud..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SpynetReporting" -ErrorAction SilentlyContinue
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SubmitSamplesConsent" -ErrorAction SilentlyContinue
Write-Host "Disabling Windows Script Host..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows Script Host\Settings" -Name "Enabled" -Type DWord -Value 0
Write-Host "Enabling Meltdown (CVE-2017-5754) compatibility flag..."
If (!(Test-Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat")) {
New-Item -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" -Name "cadca5fe-87d3-4b96-b7fb-a231484277cc" -Type DWord -Value 0
Write-Host "Enabling Malicious Software Removal Tool offering..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" -Name "DontOfferThroughWUAU" -ErrorAction SilentlyContinue
$wshell.Popup("Operation Completed",0,"Done",0x0)
})

[DocAElstein]

In support of this post
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12783
The ps1 file, and also below the $WindowsSearch.Add_Click(
Share ‘ChrisSearchTweaks18-19July.ps1 https://app.box.com/s/cbs7go8i2tdxw4wguthgxcviecaxjn6b
iex ((New-Object System.Net.WebClient).DownloadString(' https://raw.githubusercontent.com/ChrisTitusTech/win10script/71609526b132f5cd7e3b9167779af60051a80912/win10debloat.ps1'))
















$windowssearch.Add_Click({
Write-Host "Disabling Bing Search in Start Menu..."
Set-ItemProperty -Path "HKCU:\Software\Microsoft\Windows\CurrentVersion\Se arch" -Name "BingSearchEnabled" -Type DWord -Value 0
<#
Write-Host "Disabling Cortana"
Set-ItemProperty -Path "HKCU:\SOFTWARE\Microsoft\Windows\CurrentVersion\Se arch" -Name "CortanaConsent" -Type DWord -Value 0
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows\Windows Search")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows\Windows Search" -Force | Out-Null
}
#>
Write-Host "Hiding Search Box / Button..."
Set-ItemProperty -Path "HKCU:\Software\Microsoft\Windows\CurrentVersion\Se arch" -Name "SearchboxTaskbarMode" -Type DWord -Value 0

Write-Host "Removing Start Menu Tiles"

Set-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -Value '<LayoutModificationTemplate xmlns:defaultlayout="http://schemas.microsoft.com/Start/2014/FullDefaultLayout" xmlns:start="http://schemas.microsoft.com/Start/2014/StartLayout" Version="1" xmlns="http://schemas.microsoft.com/Start/2014/LayoutModification">'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <LayoutOptions StartTileGroupCellWidth="6" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <DefaultLayoutOverride>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <StartLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <defaultlayout:StartLayout GroupCellWidth="6" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </StartLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </DefaultLayoutOverride>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <CustomTaskbarLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <defaultlayout:TaskbarLayout>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:TaskbarPinList>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:UWA AppUserModelID="Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdg e" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:DesktopApp DesktopApplicationLinkPath="%APPDATA%\Microsoft\Windows\Start Menu\Programs\System Tools\File Explorer.lnk" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </taskbar:TaskbarPinList>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </defaultlayout:TaskbarLayout>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </CustomTaskbarLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value '</LayoutModificationTemplate>'

$START_MENU_LAYOUT = @"
<LayoutModificationTemplate xmlns:defaultlayout="http://schemas.microsoft.com/Start/2014/FullDefaultLayout" xmlns:start="http://schemas.microsoft.com/Start/2014/StartLayout" Version="1" xmlns:taskbar="http://schemas.microsoft.com/Start/2014/TaskbarLayout" xmlns="http://schemas.microsoft.com/Start/2014/LayoutModification">
<LayoutOptions StartTileGroupCellWidth="6" />
<DefaultLayoutOverride>
<StartLayoutCollection>
<defaultlayout:StartLayout GroupCellWidth="6" />
</StartLayoutCollection>
</DefaultLayoutOverride>
</LayoutModificationTemplate>
"@

$layoutFile="C:\Windows\StartMenuLayout.xml"

#Delete layout file if it already exists
If(Test-Path $layoutFile)
{
Remove-Item $layoutFile
}

#Creates the blank layout file
$START_MENU_LAYOUT | Out-File $layoutFile -Encoding ASCII

$regAliases = @("HKLM", "HKCU")

#Assign the start layout and force it to apply with "LockedStartLayout" at both the machine and user level
foreach ($regAlias in $regAliases){
$basePath = $regAlias + ":\SOFTWARE\Policies\Microsoft\Windows"
$keyPath = $basePath + "\Explorer"
IF(!(Test-Path -Path $keyPath)) {
New-Item -Path $basePath -Name "Explorer"
}
Set-ItemProperty -Path $keyPath -Name "LockedStartLayout" -Value 1
Set-ItemProperty -Path $keyPath -Name "StartLayoutFile" -Value $layoutFile
}

#Restart Explorer, open the start menu (necessary to load the new layout), and give it a few seconds to process
Stop-Process -name explorer
Start-Sleep -s 5
$wshell = New-Object -ComObject wscript.shell; $wshell.SendKeys('^{ESCAPE}')
Start-Sleep -s 5

#Enable the ability to pin items again by disabling "LockedStartLayout"
foreach ($regAlias in $regAliases){
$basePath = $regAlias + ":\SOFTWARE\Policies\Microsoft\Windows"
$keyPath = $basePath + "\Explorer"
Set-ItemProperty -Path $keyPath -Name "LockedStartLayout" -Value 0

Write-Host "Search and Start Menu Tweaks Complete"
} # This was missing 12 July 2021
})

[DocAElstein]

jADHKJASHDKJahdjkAHD

[DocAElstein]

<div class="gmail_chip gmail_drive_chip">&nbsp;</div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1UFQySI4QjTTV0O5xnLnLfx5iJh_qDzct/view?usp=drive_web" target="_blank" rel="noopener" aria-label="5.50 8.18 Clean Up Windows 10 _ 3 Steps For A Faster Computer-mWHiP9K8fQ0_16 10 2019.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" />&nbsp;<span dir="ltr">5.50 8.18 Clean Up Windows 10 _ 3 Steps For A ...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/11mjTzHbcdY1EwVaV0-AIAmYgC2DCsp7X/view?usp=drive_web" target="_blank" rel="noopener" aria-label="7.56 8 (Ransome) How to Make Windows 10 Secure-pGcerfVqYyU_31 01 2020.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" />&nbsp;<span dir="ltr">7.56 8 (Ransome) How to Make Windows 10 Secur...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1b_akgpleMvL4lD4qXYffzUEXh8WhUyZ7/view?usp=drive_web" target="_blank" rel="noopener" aria-label="8.45 Speed Up Windows 10 in 2020-8E6OT_QcHaU_20 06 2020.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" />&nbsp;<span dir="ltr">8.45 Speed Up Windows 10 in 2020-8E6OT_QcHaU_20...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip">&nbsp;</div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1O63RdRCQS2OvWa50F56m6KyryVsBImIK/view?usp=drive_web" target="_blank" rel="noopener" aria-label="8.94 Creating New Windows 10 Debloat Scripts fo..."><img src="https://drive-thirdparty.googleusercontent.com/16/type/video/x-ms-wmv" alt="" data-upload="true" />&nbsp;<span dir="ltr">8.94 Creating New Windows 10 Debloat Scripts fo...</span></a></div>
<div class="gmail_chip gmail_drive_chip">&nbsp;</div>

[DocAElstein]

docs.microsoft.com
learn.microsoft.com





https://web.archive.org/web/20230121190534/https://learn.microsoft.com/en-us/windows/win32/dataxchg/wm-renderformat 12/12/2020


https://web.archive.org/web/20191230120618/https://docs.microsoft.com/en-us/windows/win32/dataxchg/wm-renderformat 05/31/2018

WM_RENDERFORMAT message
05/31/2018
Sent to the clipboard owner if it has delayed rendering a specific clipboard format and if an application has requested data in that format. The clipboard owner must render data in the specified format and place it on the clipboard by calling the SetClipboardData function.










https://web.archive.org/web/20191230155738/https://docs.microsoft.com/en-us/windows/win32/dataxchg/clipboard












https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
ps://web.archive.org/web/20100506094659/http://support.microsoft.com/default.aspx/kb/221190 (ps://web.archive.org/web/20100506094659/http://support.microsoft.com/default.aspx/kb/221190)
ps://web.archive.org/web/20080508194547/http://msdn.microsoft.com/en-us/library/ms649052(VS.85).aspx (ps://web.archive.org/web/20080508194547/http://msdn.microsoft.com/en-us/library/ms649052(VS.85).aspx)
https://www.mrexcel.com/board/threads/vba-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.828241/#post-4040646 (https://www.mrexcel.com/board/threads/vba-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.828241/#post-4040646)
https://eileenslounge.com/viewtopic.php?p=246740#p246740 (https://eileenslounge.com/viewtopic.php?p=246740#p246740)
https://eileenslounge.com/viewtopic.php?p=246884#p246884 (https://eileenslounge.com/viewtopic.php?p=246884#p246884)
https://eileenslounge.com/viewtopic.php?p=246838#p246838 (https://eileenslounge.com/viewtopic.php?p=246838#p246838)
https://eileenslounge.com/viewtopic.php?p=246770#p246770 (https://eileenslounge.com/viewtopic.php?p=246770#p246770)
https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c/54960767#54960767 (https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c/54960767#54960767)
https://eileenslounge.com/viewtopic.php?p=247809#p247809 (https://eileenslounge.com/viewtopic.php?p=247809#p247809)
https://eileenslounge.com/viewtopic.php?p=247809#p247809 (https://eileenslounge.com/viewtopic.php?p=247809#p247809)
ps://web.archive.org/web/20131003213600/http://msdn.microsoft.com/en-us/library/office/ff192913.aspx (ps://web.archive.org/web/20131003213600/http://msdn.microsoft.com/en-us/library/office/ff192913.aspx)
ps://web.archive.org/web/20130113075556/http://ms (ps://web.archive.org/web/20130113075556/http://ms)
tps://www.spreadsheet1.com/how-to-copy-strings-to-clipboard-using-excel-vba.html# (tps://www.spreadsheet1.com/how-to-copy-strings-to-clipboard-using-excel-vba.html#)
https://eileenslounge.com/viewtopic.php?p=249755#p249755 (https://eileenslounge.com/viewtopic.php?p=249755#p249755)
https://eileenslounge.com/viewtopic.php?p=249795#p249795 (https://eileenslounge.com/viewtopic.php?p=249795#p249795)
http://eileenslounge.com/viewtopic.php?p=262011#p262011 (http://eileenslounge.com/viewtopic.php?p=262011#p262011)
http://eileenslounge.com/viewtopic.php?f=18&t=33834 (http://eileenslounge.com/viewtopic.php?f=18&t=33834)
https://eileenslounge.com/viewtopic.php?p=279659#p279659 (https://eileenslounge.com/viewtopic.php?p=279659#p279659)
https://www.eileenslounge.com/viewtopic.php?p=295816#p295816 (https://www.eileenslounge.com/viewtopic.php?p=295816#p295816)
https://www.eileenslounge.com/viewtopic.php?f=30&t=35100&p=295780#p295780 (https://www.eileenslounge.com/viewtopic.php?f=30&t=35100&p=295780#p295780)
https://www.eileenslounge.com/viewtopic.php?p=294721#p294721 (https://www.eileenslounge.com/viewtopic.php?p=294721#p294721)
https://www.eileenslounge.com/viewtopic.php?p=296145#p296145 (https://www.eileenslounge.com/viewtopic.php?p=296145#p296145)
https://www.eileenslounge.com/viewtopic.php?p=296126#p296126 (https://www.eileenslounge.com/viewtopic.php?p=296126#p296126)
https://www.eileenslounge.com/viewtopic.php?f=27&t=38910&p=301028#p301028 (https://www.eileenslounge.com/viewtopic.php?f=27&t=38910&p=301028#p301028)
https://www.eileenslounge.com/viewtopic.php?p=300947#p300947 (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947)
https://www.eileenslounge.com/viewtopic.php?p=300955#p300955 (https://www.eileenslounge.com/viewtopic.php?p=300955#p300955)
https://www.eileenslounge.com/viewtopic.php?p=301028#p301028 (https://www.eileenslounge.com/viewtopic.php?p=301028#p301028)
https://www.eileenslounge.com/viewtopic.php?p=301028#p301028 (https://www.eileenslounge.com/viewtopic.php?p=301028#p301028)
https://www.eileenslounge.com/viewtopic.php?p=301534#p301534 (https://www.eileenslounge.com/viewtopic.php?p=301534#p301534)
https://www.eileenslounge.com/viewtopic.php?p=301761#p301761 (https://www.eileenslounge.com/viewtopic.php?p=301761#p301761)
https://www.eileenslounge.com/viewtopic.php?p=304976#p304976 (https://www.eileenslounge.com/viewtopic.php?p=304976#p304976)
https://www.eileenslounge.com/viewtopic.php?f=26&t=39715&p=307826#p307826 (https://www.eileenslounge.com/viewtopic.php?f=26&t=39715&p=307826#p307826)
https://www.eileenslounge.com/viewtopic.php?p=303007#p303007 (https://www.eileenslounge.com/viewtopic.php?p=303007#p303007)
https://www.eileenslounge.com/viewtopic.php?p=303039#p303039 (https://www.eileenslounge.com/viewtopic.php?p=303039#p303039)
https://eileenslounge.com/viewtopic.php?p=314950#p314950 (https://eileenslounge.com/viewtopic.php?p=314950#p314950)
https://eileenslounge.com/viewtopic.php?p=289020#p289020 (https://eileenslounge.com/viewtopic.php?p=289020#p289020)
https://eileenslounge.com/viewtopic.php?p=286708#p286708 (https://eileenslounge.com/viewtopic.php?p=286708#p286708)
https://eileenslounge.com/viewtopic.php?p=289020#p289020 (https://eileenslounge.com/viewtopic.php?p=289020#p289020)
https://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/#post-223256 (https://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/#post-223256)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

In support of these issues
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12784 https://www.youtube.com/watch?v=dKM8ZScbic8&t=75s
Winget issues https://github.com/ChrisTitusTech/win10script/commit/f2774eac480a71e710f90763ea770ae56d3b6e85
https://github.com/ChrisTitusTech/win10script/commit/9c0cc78e2a15aed3d42fa1a0b3b236f3ecf290db

06.07.2021 The Best Windows Utility ( second nice shade of grey GUI )

Write-Host "Checking winget..."

Try{
# Check if winget is already installed
$er = (invoke-expression "winget -v") 2>&1
if ($lastexitcode) {throw $er}
Write-Host "winget is already installed."
}
Catch{
# winget is not installed. Install it from the Github release
Write-Host "winget is not found, installing it right now."

$download = "https://github.com/microsoft/winget-cli/releases/download/v1.0.11692/Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbu ndle"
$output = $PSScriptRoot + "\winget-latest.appxbundle"
Write-Host "Dowloading latest release"
Invoke-WebRequest -Uri $download -OutFile $output

Write-Host "Installing the package"
Add-AppxPackage -Path $output
}
Finally {
# Start installing the packages with winget
#Get-Content .\winget.txt | ForEach-Object {
# iex ("winget install -e " + $_)
#}
}




The Ultimate Windows Utility Upgrade 29 09 2021

Write-Host "Checking winget..."

Try{
# Check if winget is already installed
$er = (invoke-expression "winget -v") 2>&1
if ($lastexitcode) {throw $er}
Write-Host "winget is already installed."
}
Catch{
# winget is not installed. Install it from the Microsoft Store
Write-Host "winget is not found, installing it right now."

Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
$nid = (Get-Process AppInstaller).id
Wait-Process -Id $nid

}
Finally {
# Start installing the packages with winget
#Get-Content .\winget.txt | ForEach-Object {
# iex ("winget install -e " + $_)
#}
}

A commit a bit later by mrhaydendp to simplify a bit https://github.com/ChrisTitusTech/win10script/commit/9c0cc78e2a15aed3d42fa1a0b3b236f3ecf290db?diff=spli t

Write-Host "Checking winget..."

# Check if winget is installed
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
}

[DocAElstein]

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41784 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41784)
http://www.eileenslounge.com/viewtopic.php?p=323966#p323966 (http://www.eileenslounge.com/viewtopic.php?p=323966#p323966)
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959 (http://www.eileenslounge.com/viewtopic.php?p=323959#p323959)
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960 (http://www.eileenslounge.com/viewtopic.php?p=323960#p323960)
http://www.eileenslounge.com/viewtopic.php?p=323894#p323894 (http://www.eileenslounge.com/viewtopic.php?p=323894#p323894)
http://www.eileenslounge.com/viewtopic.php?p=323843#p323843 (http://www.eileenslounge.com/viewtopic.php?p=323843#p323843)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa6BSa17 3Z (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa6BSa17 3Z)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa6-64Xpgl (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa6-64Xpgl)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa5ms39y jd (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa5ms39y jd)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa5ZXJwR CM (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa5ZXJwR CM)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4Pr15N Ut (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4Pr15N Ut)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4I83Je lY (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4I83Je lY)
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3tnAjh ZU (https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3tnAjh ZU)
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3KswxL 3c (https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3KswxL 3c)
https://www.youtube.com/watch?v=suUqEo3QWus&lc=UgyBXFxnVWT3pqtdqPx4AaABAg (https://www.youtube.com/watch?v=suUqEo3QWus&lc=UgyBXFxnVWT3pqtdqPx4AaABAg)
https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY (https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABZ8N9O-O8p (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABZ8N9O-O8p)
http://www.eileenslounge.com/viewtopic.php?p=323547#p323547 (http://www.eileenslounge.com/viewtopic.php?p=323547#p323547)
http://www.eileenslounge.com/viewtopic.php?p=323516#p323516 (http://www.eileenslounge.com/viewtopic.php?p=323516#p323516)
http://www.eileenslounge.com/viewtopic.php?p=323517#p323517 (http://www.eileenslounge.com/viewtopic.php?p=323517#p323517)
http://www.eileenslounge.com/viewtopic.php?p=323449#p323449 (http://www.eileenslounge.com/viewtopic.php?p=323449#p323449)
http://www.eileenslounge.com/viewtopic.php?p=323226#p323226 (http://www.eileenslounge.com/viewtopic.php?p=323226#p323226)
http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150 (http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150)
http://www.eileenslounge.com/viewtopic.php?p=323085#p323085 (http://www.eileenslounge.com/viewtopic.php?p=323085#p323085)
http://www.eileenslounge.com/viewtopic.php?p=322955#p322955 (http://www.eileenslounge.com/viewtopic.php?p=322955#p322955)
http://www.eileenslounge.com/viewtopic.php?f=30&t=41659 (http://www.eileenslounge.com/viewtopic.php?f=30&t=41659)
https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY (https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY)
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABZ8N9O-O8p (https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABZ8N9O-O8p)
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgxREWxgx2z2Lza_0st4AaABAg (https://www.youtube.com/watch?v=C43btudYyzA&lc=UgxREWxgx2z2Lza_0st4AaABAg)
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgyikSWvlxbWS24NBeR4AaABAg (https://www.youtube.com/watch?v=C43btudYyzA&lc=UgyikSWvlxbWS24NBeR4AaABAg)
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgwNiH4hhyrd2UjDK8d4AaABAg (https://www.youtube.com/watch?v=C43btudYyzA&lc=UgwNiH4hhyrd2UjDK8d4AaABAg)
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HAAf952WoU ti (https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HAAf952WoU ti)
https://www.youtube.com/watch?v=hz4vb48wzMM&lc=Ugy2N3gvXBNrvWpojqR4AaABAg (https://www.youtube.com/watch?v=hz4vb48wzMM&lc=Ugy2N3gvXBNrvWpojqR4AaABAg)
http://www.eileenslounge.com/viewtopic.php?p=322462#p322462 (http://www.eileenslounge.com/viewtopic.php?p=322462#p322462)
http://www.eileenslounge.com/viewtopic.php?p=322356#p322356 (http://www.eileenslounge.com/viewtopic.php?p=322356#p322356)
http://www.eileenslounge.com/viewtopic.php?p=321984#p321984 (http://www.eileenslounge.com/viewtopic.php?p=321984#p321984)
https://eileenslounge.com/viewtopic.php?f=30&t=41610 (https://eileenslounge.com/viewtopic.php?f=30&t=41610)
https://eileenslounge.com/viewtopic.php?p=322176#p322176 (https://eileenslounge.com/viewtopic.php?p=322176#p322176)
https://eileenslounge.com/viewtopic.php?p=322238#p322238 (https://eileenslounge.com/viewtopic.php?p=322238#p322238)
https://eileenslounge.com/viewtopic.php?p=322270#p322270 (https://eileenslounge.com/viewtopic.php?p=322270#p322270)
https://eileenslounge.com/viewtopic.php?p=322300#p322300 (https://eileenslounge.com/viewtopic.php?p=322300#p322300)
http://www.eileenslounge.com/viewtopic.php?p=322150#p322150 (http://www.eileenslounge.com/viewtopic.php?p=322150#p322150)
http://www.eileenslounge.com/viewtopic.php?p=322111#p322111 (http://www.eileenslounge.com/viewtopic.php?p=322111#p322111)
http://www.eileenslounge.com/viewtopic.php?p=322086#p322086 (http://www.eileenslounge.com/viewtopic.php?p=322086#p322086)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

In support of this Thread https://eileenslounge.com/viewtopic.php?f=30&t=38110
https://eileenslounge.com/viewtopic.php?p=294721#p294721



Vertical to Horizontal,
This https://i.postimg.cc/14t4nPfD/This-Virtical.jpg (https://postimg.cc/14t4nPfD) to this https://i.postimg.cc/ygfdQprJ/That-Horizintal.jpg (https://postimg.cc/ygfdQprJ)


Part 1 The main data Vertical to Horizontal
An idea I have is to build up the single string that we know can be put into the Windows Clipboard, and then pasted out into Excel. ( http://www.eileenslounge.com/viewtopic.php?p=242941#p242941 )
I basically build that up with some Do While Loopy stuff

The Full Story
The usual worksheets defining and data getting information stuff.
( We capture one extra empty row, because, past experience with these sort of Do While Loopy stuff has shown that it can help simplify some conditional comparison things and/ or help prevent arrays doing out of bounds by one row.


Rem 1
The purpose of this is to get that maximum Amounts or Notes count, ( the biggest group ) ( which is 4 in the given example )
But its worth looking at how that works since the basic Do While Loop is then used in the next main ( Rem 2 ) section.
The #### Main Outer Loop keeps us going through all data rows
Within that the ' ---- Inner Loop that takes us through a group
This loop adds the things in the group, and after each loop is finished we check If the count was the biggest group so far.

Rem 2
This is the main meat of the solution.
First, exactly as before we have a #### Main Outer Loop keeps us going through all data rows

Within that Main Outer Loop we now have 2 inner loops.
'2a
The '2a The first inner loop one does something similar to before. It loops for a group. This time within it we build up two strings that we need for a line in the output.
As example, for the first group we are basically trying to build up these two strings, ( Just before we start that loop, we tack onto the string at the start the group name, which is A in the first group example.
This is what we would see, for example in the immediate window, for querying the string content after, in this example, the the loops for that inner loop

? strClipL
A vbTab 10 vbTab 20 vbTab 30

? strClipR
vbTab N1 vbTab N2 vbTab N3
( For the sake of clarity I use a vbTab to indicate the “invisible” vbTab characters, which is actually on those strings )
'2b
The purpose of '2b the second inner loop is to ,( if necessary ), give us effectively extra empty cells, ( achieved by adding a vbTab of the strings.
Using the same example, we would see that the loop is needed to be done once, and at the end of that single loop, our strings are modifies such:

? strClipL
A vbTab 10 vbTab 20 vbTab 30 vbTab

? strClipR
vbTab N1 vbTab N2 vbTab N3 vbTab

'2c
At this point we combine the two strings and add a line separator so that this row data can be added onto by the next row data
So as to be sure what I have and demonstrate it more clearly, I added a line in testing which calls a function of mine , ( https://excelfox.com/forum/showthread.php/2302-quot-What%e2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=15522&viewfull=1#post15522 ) , which checks that line screen,
Here is the result

"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf
That looks about correct.

Doing a few other tests, suggest to me that I have the final result that I need: https://i.postimg.cc/xcbJDZgM/StrClip.jpg (https://postimg.cc/xcbJDZgM)

? strclip
A 10 20 30 N1 N2 N3 GroupA
B 40 50 60 70 N4 N5 N6 N7 GroupB
C 80 N8 GroupC
D 90 100 N9 N10 GroupD


"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf & "B" & vbTab & "40" & vbTab & "50" & vbTab & "60" & vbTab & "70" & vbTab & "N4" & vbTab & "N5" & vbTab & "N6" & vbTab & "N7" & vbTab & "GroupB" & vbCr & vbLf & "C" & vbTab & "80" & vbTab & vbTab & vbTab & vbTab & "N8" & vbTab & vbTab & vbTab & vbTab & "GroupC" & vbCr & vbLf & "D" & vbTab & "90" & vbTab & "100" & vbTab & vbTab & vbTab & "N9" & vbTab & "N10" & vbTab & vbTab & vbTab & "GroupD" & vbCr & vbLf







' Ref
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242941
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31489#p243731
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31938#p247681
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&start=20#p246887
https://eileenslounge.com/viewtopic.php?p=294721#p294721
' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
' https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c/54960767#54960767
' https://stackoverflow.com/questions/31439866/multiple-variable-arguments-to-application-ontime/59812342#59812342
‘ http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/


‘ https://www.myonlinetraininghub.com/excel-clipboard https://support.microsoft.com/en-us/office/copy-and-paste-using-the-office-clipboard-714a72af-1ad4-450f-8708-c2931e73ec8a?ui=en-us&rs=en-us&ad=us&fromar=1#bm2b
‘ https://www.thespreadsheetguru.com/blog/2014/2/20/how-to-create-a-personal-macro-file
‘ https://excelribbon.tips.net/T009810_Cant_Empty_the_Clipboard.html
‘ https://www.excelforum.com/excel-programming-vba-macros/1288935-copy-to-clipboard-not-working.html
‘ https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
https://excelribbon.tips.net/T010691_Message_about_a_Problem_with_the_Clipboard .html
https://excel.tips.net/T003111_Cant_Copy_Data_between_Workbooks.html

' VBA to clear the Office Clipboard http://www.eileenslounge.com/viewtopic.php?p=246838&sid=e1b0b87e47d419c09c526558cc634c64#p246838

[DocAElstein]

Coding so far , for last post, https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529





' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
' http://www.eileenslounge.com/viewtopic.php?f=30&t=38110&p=294692#p294692
Sub Stantial()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.I tem(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
Do ' ############################# Main Outer Loop keeps us going through all data rows
Do ' ----------------- Inner Loop that takes us through a group
Let Cnt = Cnt + 1 ' Cnt is the main data row number
Let Cnt2 = Cnt2 + 1
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ---- Inner Loop that takes us through a group
If Cnt2 > Mx Then Let Mx = Cnt2
Let Cnt2 = 0
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows

Rem 2 ' ############################# Main Outer Loop keeps us going through all data rows
Let Cnt = 1
Do
Dim HrCnt As Long: Let HrCnt = 1
Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
Do '2a The first inner loop
Let Cnt = Cnt + 1
Let HrCnt = HrCnt + 1
Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' The first inner loop
Do While HrCnt < Mx + 1 '2b the second inner loop
Let strClipL = strClipL & vbTab
Let strClipR = strClipR & vbTab
Let HrCnt = HrCnt + 1
Loop ' the second inner loop
'2c Finishing off the strings, and final string for an output line, after the inner loops
Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf ' join the strings and add a line seperator to the output row string
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
Let strClipL = "": strClipR = ""
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste strClip out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClip
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G2")

End Sub

[DocAElstein]

Spare post for later

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=bRd4mJglWiM&lc=UgxRmh2gFhpmHNnPemR4AaABAg.A0opm95t2XEA0q3Kshmu uY (https://www.youtube.com/watch?v=bRd4mJglWiM&lc=UgxRmh2gFhpmHNnPemR4AaABAg.A0opm95t2XEA0q3Kshmu uY)
https://www.youtube.com/watch?v=bRd4mJglWiM&lc=UgxRmh2gFhpmHNnPemR4AaABAg (https://www.youtube.com/watch?v=bRd4mJglWiM&lc=UgxRmh2gFhpmHNnPemR4AaABAg)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

Following on from posts,
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16530&viewfull=1#post16530 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
http://www.eileenslounge.com/viewtopic.php?p=294692#p294692
,

The header row,
Group Amount1 Amount2 Amount3 Amount4 Notes1 Notes2 Notes3 Notes4 Name
, we could make partially dynamic, as is needed, since we don’t know the maximum number of amounts ( = maximum number of Notes ) , before seeing the data.

We do have the information needed, since Mx contains, in our current example, the required value of 4

Evaluate Range techniques are a convenient way to get these sort of things.

We start by considering spreadsheet formulas such as this,
={"Amount" & COLUMN(A1:D1)}
, which returns us an array, which applied across a range , would give us like
Amount1 Amount2 Amount3 Amount4 https://i.postimg.cc/vxWK4VnG/Amounts-Via-Spreadsheet-Array-Formula.jpg (https://postimg.cc/vxWK4VnG)

Taking that general idea and a few other steps we can finally get at our heading like in this demo coding

' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub MakeHeadings()
Dim Mx As Long: Let Mx = 4
Dim Amounts() As Variant
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A1:D1)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:D)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & "D" & ")")
' We need to get D from what we know, Mx
Dim vTemp As Variant
vTemp = Cells(1, 4).Address
vTemp = Split(vTemp, "$", 3, vbBinaryCompare)
vTemp = vTemp(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$", 3, vbBinaryCompare)(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$")(1)
vTemp = Split(Cells(1, Mx).Address, "$")(1)

Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & vTemp & ")")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")")
'
' We want this array as a string with vbTabs seperating the array elements
Dim strAmounts As String
Let strAmounts = Join(Amounts(), vbTab)
Let strAmounts = Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' similarly for the notes
Dim strNotes As String
Let strNotes = Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' To get our final heading string,
Dim strHd As String
Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Notes"

Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strHd
objDataObject.PutInClipboard
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Ws1.Paste Destination:=Ws1.Range("G1")

End Sub


In the next post , https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16533&viewfull=1#post16533 , is that integrated into the main coding in Rem 3

[DocAElstein]

Coding for these posts
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532


Sub Stantially()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.I tem(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
Do ' ############################# Main Outer Loop keeps us going through all data rows
Do ' ----------------- Inner Loop that takes us through a group
Let Cnt = Cnt + 1 ' Cnt is the main data row number
Let Cnt2 = Cnt2 + 1
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ---- Inner Loop that takes us through a group
If Cnt2 > Mx Then Let Mx = Cnt2
Let Cnt2 = 0
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows

Rem 2 ' ############################# Main Outer Loop keeps us going through all data rows
Let Cnt = 1
Do
Dim HrCnt As Long: Let HrCnt = 1
Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
Do '2a The first inner loop
Let Cnt = Cnt + 1
Let HrCnt = HrCnt + 1
Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' The first inner loop
Do While HrCnt < Mx + 1 '2b the second inner loop
Let strClipL = strClipL & vbTab
Let strClipR = strClipR & vbTab
Let HrCnt = HrCnt + 1
Loop ' the second inner loop
'2c Finishing off the strings, and final string for an output line, after the inner loops
Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf ' join the strings and add a line seperator to the output row string
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
Let strClipL = "": strClipR = ""
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste strClip out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClip
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G2")

Rem 3 headers
Dim strHd As String
Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Name"
objDataObject.SetText Text:=strHd
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G1")

End Sub

[DocAElstein]

Some extra notes for this main forum post:
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331

This is a sample input,

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B

21,2,3,4t,y,u,m
Worksheet: Sheet2Original

This is what I want out

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B

2
1t


3
2y


4
3u


5
4m
Worksheet: Sheet2


I want to do this sort of thing,

__ arrOut()= App.Index(arrIn(), Rws(), Clms())

The arrIn() in this case will be all the input data. Conveniently, we can join the two cell values with a comma then split all that by comma to get a single array, {1 2 3 4 t y u m }
Then we need the Rws() like this
1 1
1 1
1 1
1 1
and the Clms() like this
1 5
2 6
3 7
4 8


' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16639&viewfull=1#post16639
Sub SplitData4()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
Dim Rws() As Variant
Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
Let arrOut() = Application.Index(arrIn(), Rws(), Clms())

Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Rws(), Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))

End Sub
Sub StantiallyBeautiful() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub



In actual fact, we can simplify things a bit , since Intersexual interception theory (https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp) tells us that if Excel is looking for the indicies of this form
A b
C d
E f
G h
, but we only give it
1
, then it will see this instead
1 1
1 1
1 1
1 1

So that means we can replace Rws() with just 1
So that all simplifies it a bit…

Sub SplitData4b()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
'Dim Rws() As Variant
' Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
' Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
' Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
Let arrOut() = Application.Index(arrIn(), 1, Clms())
Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

Sub StantiallyBeautifulb() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

[DocAElstein]

some more notes on it....


later.....

[DocAElstein]

White Spam URL WhiteSpamUrl WhiteSpamUrl()


Sub WhiteSpamUrl() ' White Spam URL WhiteSpamUrl WhiteSpamUrl() https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18376&viewfull=1#post18376
Dim ClipTxt As String: Let ClipTxt = " https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)" & vbCr & vbLf
Dim SelText As String
Let SelText = Selection.Text
Dim RwTxt() As String
Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
Dim ClmTxt() As String
Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
Dim ClmCnt As Long
For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Then
Dim URL As String, URL2 As String
Let URL = Trim(ClmTxt(ClmCnt))
Let URL2 = Replace(URL, "http", "http", 1, 1, vbBinaryCompare)
Let URL2 = Replace(URL2, "//www.", "//www.", 1, 1, vbBinaryCompare)
Let ClipTxt = ClipTxt & " " & URL2 & " ( & URL & )" & vbCr & vbLf
Else
' no url
End If

Next ClmCnt
Next RwCnt
Let ClipTxt = ClipTxt & " https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)"

' Put the string in the clipboard
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
.SetText ClipTxt
.PutInClipboard
End With
End Sub

[DocAElstein]

Sub FuckoffvbCrandvbLfinwordtext() ' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18377&viewfull=1#post18377
Dim ClipTxt As String ': Let ClipTxt = " https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)" & vbCr & vbLf
Dim SelText As String
Let SelText = Selection.Text

Let ClipTxt = Replace(SelText, vbCr, "", 1, -1)
Let ClipTxt = Replace(ClipTxt, vbLf, "", 1, -1)
' Put the string in the clipboard
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
.SetText ClipTxt
.PutInClipboard
End With
End Sub






Sub SplitDataFlexibly() '
Rem 1 worksheets data info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("Sheet1")
Dim Lc As Long: Let Lc = Ws1.Cells(2, Ws1.Columns.Count).End(xlToLeft).Column: Lc = Cells(2, Columns.Count).End(xlToLeft).Column
Rem 2 create a 1 Dimensional array of all data
Dim LCL As String: Let LCL = Split(Cells(1, Lc).Address, "$", 3, vbBinaryCompare)(1): LCL = Split(Cells(1, Lc).Address, "$")(1) ' what we are doing is splitting like $D$1 by the $ and then taking the second element, in the example that will be D
Dim arrCels2D1Row() As Variant: Let arrCels2D1Row() = Ws1.Range("A2:" & LCL & "2").Value2
Dim arrCels1D() As Variant: Let arrCels1D() = Application.Index(arrCels2D1Row(), 1, 0)
Dim strDta As String: Let strDta = Join(arrCels1D(), ",") 'Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Rem 3 Making previous solution dynamic, - requires changing B with " & LCL & " and some hard coded occurasnces of 2 with Lc
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Join(arrCels1D(), ","), ",")
Dim Clms() As Variant
' the next lines, used in previous example. is for the case of two cells, so we need to change some hard coded stuff to make the solution dynamic. ' Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
' Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(arrIn(), 1, Clms())
' Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' This was the case for 2 cells
Let Ws1.Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(arrC els2D1Row(), 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(arr Cels2D1Row(), 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1. Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1 .Range("A2:" & LCL & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1. Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1 .Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = _
Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))

End Sub

[DocAElstein]

In support of this main Forum post:
http://www.eileenslounge.com/viewtopic.php?p=297074#p297074 http://www.eileenslounge.com/viewtopic.php?p=297074#p297074
First overcomplicated Solution

Hello

.... in real these values will go to another WBK.
:::
or now just one question, "public" will always declare for userfrom means storing value either within WBK or for Other WBK.

Public means that the variable will be "known" in all code modules of the same workbook, but not in code modules in other open workbooks. .
If Public variables are being the things that go in a normal code module, as I think they are, technically, or officially, or words to that effect, then that is the case that they won’t be known in other workbooks.
In other words, for the purposes of what is going on here, it means you will need to be storing them in the same workbook, as Hans said, and how he demonstrated.

However, you can do something that technically is not involving Public variables, but as far as I can tell, to all intents and purposes, is in effect the same thing as if you could have those Public variable in a different workbook.

The short story is:
Instead of putting the two public variables in a standard normal code module, ( in the same workbook) as Hans did, we can put them in any Class object code module in any open workbook. Technically they are not called Public variables. They are , I think, properties of the instantiated Class object, and we can access them, in the usual way that we access properties of an object.

The full story
PurseWayDoughPublicVariables.xls
I have another workbook uploaded, PurseWayDoughPublicVariables.xls . That is just to hold these variables. (I will call them “pseudo” Public variables, just because I feel like it :) ),
I can put them in any Class object code module, but just for fun, I will put C1 in a worksheet code module, and C2 in the ThisWorkbook code module.

So, this is what Hans did, public variables in a standard normal module like
Standard module, Module1

Public C1 As String
Public C2 As String

Instead of doing that , I will put those variables in Class object code modules in PurseWayDoughPublicVariables.xls, like this:

Worksheet code module, Sheet1

Public C1 As String
'
'
'
Sub PhilC1(ByVal Wrd As String)
Let C1 = Wrd
End Sub


Workbook code module, ThisWorkbook

Public C2 As String
'
'
'
Sub PhilC2(ByVal Wrd As String)
Let C2 = Wrd
End Sub

*** The reason for those extra macros that fill the variables will be apparent shortly….
_.__________________________________-

Sample for Eli.xlsm
I need to modify now the workbook uploaded by Hans, in 3 main ways:
_(i) I don’t need the two public variables in a standard normal code module anymore
_(ii) I need to modify slightly how I reference the variables

Sub Fi_l()
'Act_ive
'Let Range("A2").Resize(10).Value = C1
Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
'let Range("B2").Resize(10).Value = C2
Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub

_(iii) Filling the variable is slightly more tricky. As far as I know, I can’t easily directly fill them from a macro in Sample for Eli.xlsm. - ***Edit: not true - see next post!! But I can run those extra macros*** that fill the variables, from Sample for Eli.xlsm
So to do that I modify the coding in the UserForm thus, ( for the purposes of this demo, I assume the two workbooks are stored in the same place):

Private Sub CommandButton1_Click()
Select Case Me.CheckBox1
Case True
'C1 = "yes"
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
End Select
Select Case Me.CheckBox2
Case True
'C2 = "yes"
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.Phi lC2", Arg1:="Ja"
End Select
Unload Me
Call Sheet2.Fi_l
End Sub


_.____

That’s it. So download both files, store them in the same place, and then the coding in Sample for Eli.xlsm should work as before. The only difference is that you are using the “pseudo” public variables in the workbook PurseWayDoughPublicVariables.xls

_.________________________________________________ _____________________


I have not seen this use of “pseudo” public variables much before, so there may be some reason I don’t know about why they should not be used??
But I use them myself sometimes, and so far I have never seen them behave any differently to “proper” public variables

( I would just finally say that I don’t use public variables much myself, pseudo or otherwise, if I can find another way to do what I want. I don’t like public variables myself. For one reason: I find they have an annoying habit of getting emptied sometimes. )



Alan


Ref
https://stackoverflow.com/questions/42908101/run-code-in-worksheets-class-code-module-in-another-workbook#
https://excelfox.com/forum/showthread.php/2404-Notes-tests-Application-Run-OnTime-Multiple-Variable-Arguments-ByRef-ByVal?p=11870&viewfull=1#post11870
https://stackoverflow.com/questions/31439866/multiple-variable-arguments-to-application-ontime/59812342#59812342
https://www.mrexcel.com/board/threads/reading-a-global-variable-from-another-workbook.963503/#post-4629654

[DocAElstein]

' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
' http://www.eileenslounge.com/viewtopic.php?f=30&t=38110&p=294692#p294692
Sub Stantial()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.I tem(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
Do ' ############################# Main Outer Loop keeps us going through all data rows
Do ' ----------------- Inner Loop that takes us through a group
Let Cnt = Cnt + 1 ' Cnt is the main data row number
Let Cnt2 = Cnt2 + 1
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ---- Inner Loop that takes us through a group
If Cnt2 > Mx Then Let Mx = Cnt2
Let Cnt2 = 0
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows

Rem 2 ' ############################# Main Outer Loop keeps us going through all data rows
Let Cnt = 1
Do
Dim HrCnt As Long: Let HrCnt = 1
Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
Do '2a The first inner loop
Let Cnt = Cnt + 1
Let HrCnt = HrCnt + 1
Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' The first inner loop
Do While HrCnt < Mx + 1 '2b the second inner loop
Let strClipL = strClipL & vbTab
Let strClipR = strClipR & vbTab
Let HrCnt = HrCnt + 1
Loop ' the second inner loop
'2c Finishing off the strings, and final string for an output line, after the inner loops
Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf ' join the strings and add a line seperator to the output row string
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
Let strClipL = "": strClipR = ""
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste strClip out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClip
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G2")

End Sub








_.________________________________________________ _______________________________




Following on from posts,
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16530&viewfull=1#post16530 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
http://www.eileenslounge.com/viewtopic.php?p=294692#p294692
,

The header row,
Group Amount1 Amount2 Amount3 Amount4 Notes1 Notes2 Notes3 Notes4 Name
, we could make partially dynamic, as is needed, since we don’t know the maximum number of amounts ( = maximum number of Notes ) , before seeing the data.

We do have the information needed, since Mx contains, in our current example, the required value of 4

Evaluate Range techniques are a convenient way to get these sort of things.

We start by considering spreadsheet formulas such as this,
={"Amount" & COLUMN(A1:D1)}
, which returns us an array, which applied across a range , would give us like
Amount1 Amount2 Amount3 Amount4 https://i.postimg.cc/vxWK4VnG/Amounts-Via-Spreadsheet-Array-Formula.jpg (https://postimg.cc/vxWK4VnG)

Taking that general idea and a few other steps we can finally get at our heading like in this demo coding

' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub MakeHeadings()
Dim Mx As Long: Let Mx = 4
Dim Amounts() As Variant
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A1:D1)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:D)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & "D" & ")")
' We need to get D from what we know, Mx
Dim vTemp As Variant
vTemp = Cells(1, 4).Address
vTemp = Split(vTemp, "$", 3, vbBinaryCompare)
vTemp = vTemp(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$", 3, vbBinaryCompare)(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$")(1)
vTemp = Split(Cells(1, Mx).Address, "$")(1)

Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & vTemp & ")")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")")
'
' We want this array as a string with vbTabs seperating the array elements
Dim strAmounts As String
Let strAmounts = Join(Amounts(), vbTab)
Let strAmounts = Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' similarly for the notes
Dim strNotes As String
Let strNotes = Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' To get our final heading string,
Dim strHd As String
Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Notes"

Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strHd
objDataObject.PutInClipboard
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Ws1.Paste Destination:=Ws1.Range("G1")

End Sub


In the next post , https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16533&viewfull=1#post16533 , is that integrated into the main coding in Rem 3







In support of this main Forum post:
http://www.eileenslounge.com/viewtopic.php?p=297074#p297074 http://www.eileenslounge.com/viewtopic.php?p=297074#p297074
Second simplified Solution

I think in the first solution I made initially a mistake in trying to set the pseudo public variables, *** and so went off in a tangent using the Application.Run stuff. You don’t need any of that and can forget the two macros that fill the variables as well.

You just need this

Worksheet code module, Sheet1 ( in PurseWayDoughPublicVariables.xls )

Public C1 As String

Workbook code module, ThisWorkbook ( in PurseWayDoughPublicVariables.xls )

Public C2 As String


And then the other macros are like


Private Sub CommandButton1_Click()
Select Case Me.CheckBox1
Case True
'C1 = "yes"
' Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
Let Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1 = "Yus"
End Select
Select Case Me.CheckBox2
Case True
'C2 = "yes"
' Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.Phi lC2", Arg1:="Ja"
Let Workbooks("PurseWayDoughPublicVariables.xls").C2 = "Ja"
End Select
Unload Me
Call Sheet2.Fi_l
End Sub



Sub Fi_l()
'Act_ive
'Let Range("A2").Resize(10).Value = C1
Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
'let Range("B2").Resize(10).Value = C2
Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub

[DocAElstein]

In support of this main forum post
https://excelfox.com/forum/showthread.php/2815-Copy-data-from-multiple-rows-between-two-keyword-and-paste-the-data-in-row(s)-of-single-cell-in-sheet2





Sub WhatsInColumnA()
Rem 0 worksheets data info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Rem 1 Put data range in clipboards
Ws1.UsedRange.Copy
Rem 2 get text data from windows clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Dim StringBack As String
objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
Rem 3 Analyse string back from windows clipboard
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(StringBack) ' https://pastebin.com/raw/eutzzxHv
End Sub

Results

"""" & "234" & "." & " " & Chr(42) & ChrW(8230) & "." & "Keywrod1" & ":" & " " & vbLf & "2021" & "-" & "2022" & Chr(42) & Chr(42) & Chr(42) & """" & vbCr & vbLf & vbCr & vbLf & """" & "This also " & vbLf & "text channel" & "." & """" & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & """" & vbCr & vbLf & vbCr & vbLf & "Keywrod1" & ":" & " " & vbCr & vbLf & "Keyword2" & ":" & " QWERTY" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & """" & "2344" & "." & " " & ChrW(8230) & "." & "Keywrod1" & ":" & " " & Chr(42) & Chr(42) & Chr(42) & " 2020" & "-" & "2021" & vbLf & "digital information" & vbLf & "digital information" & """" & vbCr & vbLf & vbCr & vbLf & """" & "Digital marketing" & ":" & " " & "=" & vbLf & "also to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." &
"""" & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & """" & vbCr & vbLf & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & """" & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & """" & vbCr & vbLf & "Keywrod1" & ":" & " " & Chr(42) & Chr(42) & Chr(42) & " 2020" & "-" & "2021" & vbCr & vbLf & """" & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & """" & vbCr & vbLf & "Keyword2" & vbCr & vbLf



Compare that with the range copied manually and pasted here, and a screenshot of the spreadsheet ( with wrap text enabled )

"234. *….Keywrod1:
2021-2022***"

"This also
text channel."
"Digital to
connect communication. "


"Digital to
connect communication.
This also
text channel."

Keywrod1:
Keyword2: QWERTY


"2344. ….Keywrod1: *** 2020-2021
digital information
digital information"

"Digital marketing: =
also to
connect communication.
This also
text channel."
"Digital to
connect communication. "

"Digital to
connect communication.
This also
text channel."
"Digital to
connect communication.
This also
text channel."
Keywrod1: *** 2020-2021
"Digital to
connect communication.
This also
text channel."
Keyword2

https://i.postimg.cc/HkM0Yxqk/Screenshot-with-Wrap-Text-Enabled.jpg (https://postimages.org/)

Conclusions
The row separator in the windows clipboard is that most typically used for a new line in computing, a Carriage return and a Line feed ( in VBA coding vbCr & vbLf ).
For a new line within a cell, we have the typical convention in Excel of just the Line feed ( in VBA coding, vbLf )
In the case of 2 or more lines within a cell, the entire string for the cell is enclosed in a pair of quotes. ( I expect this is to help avoid the vbLf being taken as a new row )




VBA row to cell1 reduced data.xls : https://app.box.com/s/qne60lkrfp30d50w444gedzjg6b7nyat
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16735&viewfull=1#post16735

[DocAElstein]

Here is an alternative single liner ( almost ## ) type solution to the last post. It was much simpler than I expected, and ends up much shorter than these solutions of mine usually do. (## There was a small snag, not solved yet, which means I have to do it in 2 code lines for now. I may take a look at that later here: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16655&viewfull=1#post16655 )

Solution explanation.
Part 1. Background
This is all to do with
_ “my”** ____arrOut()=Index(ArrIn(), Rws(), Clms()) ______ type solutions, ( https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 )
and also
_ using the Match in a similar way – ( some time ago I obsessed with trying out Application.Match where the first argument is an array, in a similar way to those of those array arguments Rws() and Clms() in Index. I got so obsessed I littered a sub forum with over long posts until they deleted them all and limited the post size to stop me doing it again. With hindsight, not a bad thing to do, as I could not see the wood for the trees back then. I can now, and its not at all difficult to understand, so I really don’t need all that crap anymore. Let me call that for now “my” **
________arrOut() = Match(arrArg1(), arrIn() , 0 ) ___ type solution.
( ** I use the word “my” lightly. – I learnt all this stuff from looking at stuff from Rick Rothstein and snb. ( I am not sure if they “invented it” , or got it from other peoples stuff. if I added anything “new” , it might be some of my detailed explanations, which whilst I don’t know if they are correct, they seem to be a valid theory as they go a long way to explain the results ) )


Here is a quick demo of how
_ my ____arrOut()=Match(arrArg1(), arrIn() , 0 ) ____ works
Ordinarily, or most usually the first argument is just one thing that you are looking for. As far as I know all documentation tells you that the way Match in Excel works is, ( simplified ) :
_... you look in the second argument array of things for the thing in the first argument, and , assuming you find it, return the position along where it is, pseudo like
_____ Match( b , { a, b, c } , 0 ) = 2
In the practice we sometimes, ( not always ) , find that things in Excel will work with array arguments and return a corresponding array of outputs. So taking that last example, pseudo like
_____ Match( {b, a} , { a, b, c } , 0 ) = {2, 1}

So that is a bit of theory out of the way. ( I have done a fuller explanation in a few places of how the Application.Index with Look Up Rows and Columns Arguments as VBA Arrays works in a few places
https://excelfox.com/forum/showthread.php/2788-Explain-App-Index(Rng-Rws()-Clms())-(multicolumn-Combobox-with-Index-application)?p=16455&viewfull=1#post16455
https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 )



Part 2. Here is my solution examples
Refering to the first long macro below:

Rem1 is just making some stuff I need for the demo. I use the string example of “ZAC” as per the original OP example http://www.eileenslounge.com/viewtopic.php?f=30&t=38460 . For reasons given in the next bit, I make an array of the 26 Ascii Code numbers for the capital alphabet characters, A, B. C ….Z , Asskeys() = { 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90 }
My array of the weights values, Weights(), for the characters will be the same size as Asskeys() and will have the corresponding weight value for each of the 26 characters in the same order.
Once again it will be clear why later. For now, the point is to have arrays of the same size with related things in the same order

' ' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' ' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
' Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)


Rem 2
I found a way on the internet to turn my string example into an array of single characters, which is what I will be feeding into my Match as first argument. ( Unfortunately it does not return in each element the character, but rather its Ascii Code. But for my purposes that’s just as good.

Rem 3 Match
This is the Match bit, and it tells me the position along where I find the three Ascii Code numbers of “ZAC” in the Ascii Code array, Asskeys()
We get from match here, a 3 element array, MtchRes(), of the position along, of the characters in “ZAC” in the array Asskeys(). We have organised that the array of weights is organised in the same order, so this will also be the position along of the corresponding weight number in the array of weights, Weights().
In the example we should have then an array like {26, 1, 3} _ ( if you have followed the logic so far, you can see this is like a pseudo Alphabet position of the characters, Z , A , and C __ (But don’t get confused with Ascii codes, which is pseudo like the official position of characters, and defined by some world standard, that Excel knows about. As example, capital A is listed as Ascii code 65, lowercase a is listed as 97 )

Rem 4 Index
The 3 element array of the position along, of the characters in “ZAC” in the array Asskeys(), is effectively the Clms() array we need for a __arrOut()=Index(ArrIn(), Rws(), Clms())__type solution, where the look up array, arrIn() , will be the weights array, Weights()
The returned array from Index , arrOut(), will be an array, of 3 numbers, which are the weight numbers for the example string “ZAC”.

Rem 5
Finally we simply sum the elements of the found weight values, as per the original OP request.

Sub AssKeys()
Rem 1 Make the arrays and other hard coded things for the demo
Dim AssKeys(1 To 26) As Long
Dim Eye As Long
For Eye = 65 To 90 Step 1
Let AssKeys(Eye - 64) = Eye
Next Eye
' OR
' Dim AssKeys() As Variant: Let AssKey() = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90)
Dim Weights() As Variant:
' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)
Dim ZAC As String
Let ZAC = "ZAC" ' This is a demo example text string
Rem 2 String to array
Dim arrZAC() As Byte: Let arrZAC() = StrConv(ZAC, vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Rem 3 Match
Dim MtchRes() As Variant
Let MtchRes() = Application.Match(arrZAC(), AssKeys(), 0)
Rem 4 Index
Dim arrOut() As Variant
Let arrOut() = Application.Index(Weights(), 1, MtchRes())
Rem 5
Dim Some As Long: Let Some = Application.Sum(arrOut())
End Sub

Here the shortening possibilities


Sub BeautifulAsskeys()
Rem 1 Make the arrays and other hard coded things for the demo
'Dim Asskeys(1 To 26) As Long
'Dim Eye As Long
' For Eye = 65 To 90 Step 1
' Let Asskeys(Eye - 64) = Eye
' Next Eye
' OR
' Dim AssKeys() As Variant: Let AssKey() = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90)
'Dim Weights() As Variant:
' ' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' ' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
' Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)
'Dim ZAC As String
' Let ZAC = "ZAC" ' This is a demo example text string
Rem 2 String to array
Dim arrZAC() As Byte: Let arrZAC() = StrConv("ZAC", vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Rem 3 Match
'Dim MtchRes() As Variant
' Let MtchRes() = Application.Match(arrZAC(), Asskeys(), 0)
' Let MtchRes() = Application.Match(StrConv(ZAC, vbFromUnicode), Asskeys(), 0)' this does not work
Rem 4 Index
'Dim arrOut() As Variant
' Let arrOut() = Application.Index(Weights(), 1, MtchRes())
Rem 5
Dim Some As Long: Let Some = Application.Sum(Application.Index(Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2), 1, Application.Match(arrZAC(), Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90), 0)))
End Sub
'
Sub AsKeys() ' http://www.eileenslounge.com/viewtopic.php?p=297288#p297288
Dim arrZAC() As Byte: Let arrZAC() = StrConv("ZAC", vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Dim Some As Long: Let Some = Application.Sum(Application.Index(Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2), 1, Application.Match(arrZAC(), Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90), 0)))
End Sub








** I use the word “my” lightly. – I learnt all this stuff from looking at stuff from Rick Rothstein and snb. ( I am not sure if they “invented it” , or got it from other peoples stuff. if I added anything “new” , it might be some of my detailed explanations, which whilst I don’t know if they are correct, they seem to be a valid theory as they go a long way to explain the results

[DocAElstein]

Solution 1 for here
https://excelfox.com/forum/showthread.php/2815-Copy-data-from-multiple-rows-between-two-keyword-and-paste-the-data-in-row(s)-of-single-cell-in-sheet2




Sub ConsolidateLines_Solution1() ' https://excelfox.com/forum/showthread.php/2815-Copy-data-from-multiple-rows-between-two-keyword-and-paste-the-data-in-row(s)-of-single-cell-in-sheet2
Rem 0 worksheets data info
Dim Ws1 As Worksheet, Ws2 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1): Set Ws2 = ThisWorkbook.Worksheets.Item(2)
Rem 1 Put data range in clipboards
Ws1.UsedRange.Copy
Rem 2 get text data from windows clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Dim StringBack As String ' This has the entire text held for the range in the windows clipboard after a .Copy
objDataObject.GetFromClipboard: Let StringBack = objDataObject.GetText()
Rem 3 Initial to get started, finding first start point of text we want
Dim PosK1 As Long: Let PosK1 = InStr(1, StringBack, "Keywrod1", vbBinaryCompare)
Dim Pos1 As Long: Let Pos1 = InStrRev(Left(StringBack, PosK1), vbCr & vbLf, -1, vbBinaryCompare)
If Pos1 = 0 Then Let Pos1 = 1 ' this is for the case if first Keywrod1 is in the first cell with text in, so we have no new line character to find
Let Pos1 = Pos1 + 2 ' If Keywrod1 was not in the first cell with text in it, then we are at the start of a vbCr & vbLf pair. We don't want that pair so move to just past it
Rem 4 main text manipulation
'4a) will loop as long as we have a next pair of keywords
Do While PosK1 <> 0 ' This the main outer loop will terminate if we find no new first keyword ################
Dim PosK2 As Long: Let PosK2 = InStr(Pos1, StringBack, "Keyword2", vbBinaryCompare) ' we have the first keyword and the start of text in it, now we find the second keyworrd.....
If PosK2 = 0 Then Exit Do ' A possible finish if a first keyword was found but no second one after - a check that we have a matching next second keyword, so as not to loop further in the case of a first keyword towards the end of the data, but no final second keyword
Dim Pos2 As Long: Let Pos2 = InStr(PosK1, StringBack, vbCr & vbLf, vbBinaryCompare) ' This will find the next cell defining new line characters after the second keyword.
Dim celStr As String ' This is used to manipulate a string from a cell
Let celStr = Mid(StringBack, Pos1, Pos2 - Pos1) ' We need the actial text we want. We have the start position. Pos1. Our Pos2 is at the start of the vbCr & vbLf pair, just one character above the last text we want. So Pos2-Pos1 willl give us out text length is what we want for the 3rd argumant of the VBA Mid function ( For the VBA Mid Function the first argument is the main text, the second argument from where we want to start taking the text )
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(celStr) ' """" & "234" & "." & " " & Chr(42) & ChrW(8230) & "." & "Keywrod1" & ":" & " " & vbLf & "2021" & "-" & "2022" & Chr(42) & Chr(42) & Chr(42) & """" As example, this is what cell A2 gave https://pastebin.com/raw/eutzzxHv
If InStr(1, celStr, vbLf, vbBinaryCompare) <> 0 Then Let celStr = Replace(celStr, """", "", 1, 2, vbBinaryCompare) ' This should remove the enclosing quotes around multi line text
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(celStr) ' "234" & "." & " " & Chr(42) & ChrW(8230) & "." & "Keywrod1" & ":" & " " & vbLf & "2021" & "-" & "2022" & Chr(42) & Chr(42) & Chr(42)
Dim NewCelStr As String ' This is used to build the string for a new cell
Let NewCelStr = NewCelStr & celStr & vbLf
'4b) We are stepping through all the cells within a keyword pair
Do While Pos2 < PosK2 ' This keeps going untill we pass the current second keyword at PosK2 ----|
'Let celStr = "" ' We want to manipulate the next cell string'
Let Pos1 = InStr(Pos2, StringBack, vbCr & vbLf, vbBinaryCompare) + 2 ' This should take us to the start of the text in the next cell
Let Pos2 = InStr(Pos1, StringBack, vbCr & vbLf, vbBinaryCompare) ' This should take us to the end of the string in the next cell
Let celStr = Mid(StringBack, Pos1, Pos2 - Pos1)
If InStr(1, celStr, vbLf, vbBinaryCompare) <> 0 Then Let celStr = Replace(celStr, """", "", 1, 2, vbBinaryCompare) ' This should remove the enclosing quotes around multi line text
Let NewCelStr = NewCelStr & celStr & vbLf
Loop ' This is building the new cell string from cells in column A within the keywords ----------|
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(NewcelStr) ' "234" & "." & " " & Chr(42) & ChrW(8230) & "." & "Keywrod1" & ":" & " " & vbLf & "2021" & "-" & "2022" & Chr(42) & Chr(42) & Chr(42) & vbLf & vbLf & "This also " & vbLf & "text channel" & "." & vbLf & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & vbLf & vbLf & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & vbLf & vbLf & "Keywrod1" & ":" & " " & vbLf & "Keyword2" & ":" & " QWERTY" & vbLf
'4c) ' At this point we have the complete text for a new single cell, (and an extra trailing vbLf)
'If Left(NewcelStr, 2) = vbCr & vbLf Then Let NewcelStr = Mid(NewcelStr, 3) ' I am not too sure yet about this bodge. I seem to catch an extra row seperator, not sure why yet
Let NewCelStr = Left(NewCelStr, Len(NewCelStr) - 1) ' Take off last trailing vbLf
If InStr(1, NewCelStr, vbLf, vbBinaryCompare) <> 0 Then Let NewCelStr = """" & NewCelStr & """" ' we need to enclose the final new cell string in a quote pair, so that the windows clipboard knows we have a single cell with multiline text
Let NewCelStr = NewCelStr & vbCr & vbLf ' we add the line seperator that the windows clipboard recognises as a row in Excel
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(NewcelStr) ' """" & "234" & "." & " " & Chr(42) & ChrW(8230) & "." & "Keywrod1" & ":" & " " & vbLf & "2021" & "-" & "2022" & Chr(42) & Chr(42) & Chr(42) & vbLf & vbLf & "This also " & vbLf & "text channel" & "." & vbLf & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & vbLf & vbLf & "Digital to " & vbLf & "connect communication" & "." & " " & vbLf & "This also " & vbLf & "text channel" & "." & vbLf & vbLf & "Keywrod1" & ":" & " " & vbLf & "Keyword2" & ":" & " QWERTY" & """" & vbCr & vbLf
' we are now ready to move on to the text for the next new cell
Dim Finalstr As String: Let Finalstr = Finalstr & NewCelStr ' we add the current complete new cell text to a final text which will be put in the windows clipboard
Let PosK1 = InStr(Pos2, StringBack, "Keywrod1", vbBinaryCompare) '
If PosK1 <> 0 Then Let Pos1 = InStrRev(Left(StringBack, PosK1), vbCr & vbLf, -1, vbBinaryCompare) + 2
Let NewCelStr = ""
Loop ' ### Main outer loop terminates when main text manipulation is finished ################################
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Finalstr)
Rem 5 Put new text in clipboard
objDataObject.Clear
objDataObject.SetText Text:=Finalstr
objDataObject.PutInClipboard
Rem 6 .Paste out from windows clipboard
Ws2.Columns(1).Clear
Ws2.Paste Destination:=Ws2.Range("A2")
Ws2.Columns(1).WrapText = False
End Sub

[DocAElstein]

In support of this main forum post
https://eileenslounge.com/viewtopic.php?f=30&t=39339


We want to transform something like this…


CodeDate1Date2Form_ScoreQuestionAnswer

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S1Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S2Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S3NA

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S4NA

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S5Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S6Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S7Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S8NA

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S9NA

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S10Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S11NA

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S12Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S13Yes

636462-5-2023 8:04:24 AM1-31-2023 2:03:23 PM100S14Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S1Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S2Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S3NA

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S4NA

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S5Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S6Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S7Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S8NA

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S9NA

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S10Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S11NA

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S12Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S13Yes

636472-5-2023 8:09:16 AM1-31-2023 12:35:46 PM100S14Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S1Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S2Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S3NA

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S4NA

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S5Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S6Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S7Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S8NA

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S9NA

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S10Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S11NA

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S12Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S13Yes

636502-5-2023 8:16:48 AM1-31-2023 7:31:20 PM100S14Yes

636532-5-2023 8:23:01 AM1-31-2023 1:25:53 PM100S1Yes

636532-5-2023 8:23:01 AM1-31-2023 1:25:53 PM100S2Yes

636532-5-2023 8:23:01 AM1-31-2023 1:25:53 PM100S3Yes

636532-5-2023 8:23:01 AM1-31-2023 1:25:53 PM100S4NA

636532-5-2023 8:23:01 AM1-31-2023 1:25:53 PM100S5Yes
Worksheet: Sheet1


…. To something like this


CodeDate1Date2Form_ScoreS1S2S3S4S5S6S7S8S9S10S11S1 2S13S14

6364602-05-2023 08:0401-31-2023 14:03100YesYesNANAYesYesYesNANAYesNAYesYesYes

6364702-05-2023 08:0901-31-2023 12:35100YesYesNANAYesYesYesNANAYesNAYesYesYes

6365002-05-2023 08:1601-31-2023 19:31100YesYesNANAYesYesYesNANAYesNAYesYesYes

6365302-05-2023 08:2301-31-2023 13:25100YesYesYesNAYes




….. One way to do it in the next post ( https://excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=19821&viewfull=1#post19821
https://excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page52#post19821 )

[DocAElstein]

….Continued from last post ( https://excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=19820&viewfull=1#post19820
https://excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page52#post19820 )


The dictionary type way, like already done there by Hans ( https://eileenslounge.com/viewtopic.php?p=304935&sid=439d7d0e43649d28e227088795e527ed#p304935 ). is quite common and a good way. Often it’s the best , most efficient way.

Just for comparison to further the subject and discussion a bit , here’s another way.
To main differences, or rather two main things being done which are uncommon , or at least less common, as yet,

_1) Do While Loops
we use two Do While Loop things, one nested in the other.
The inner loop goes through each row in each of the ( in this example data ) 4 sections, and the outer Loop just takes us on to the next section. So effectively we loop through each data row. Potentially this my reduce the number of loops compared to other ways
The main thing that goes on is that a single string is built up, and that string contains most of the output data. This is arranged in a format such that the data column separator is the vbTab, and the row / line separator is the typical vbCr & vbLf pair
_2) Use of Clipboard
The string built up is put in the Clipboard. The Clipboard recognises the format as that of a Excel range, so we can paste that out.



Sub Transformator()
Rem 0 worksheets and data info
Dim Wss As Worksheet, Wst As Worksheet
Set Wss = ThisWorkbook.Worksheets.Item(1): Set Wst = ThisWorkbook.Worksheets.Item(3)
Dim CuRe As Range
Set CuRe = Wss.Range("A1").CurrentRegion
Set CuRe = CuRe.Resize(CuRe.Rows.Count + 1) ' An extra empty row is often useful to make a Do While Loop thing of this sort teminate and not error when looking at the next after last
Dim Ars() As Variant
Let Ars() = CuRe.Value
Rem 1 This is a Do While Loop nested in another Do While Loop In effect it loops through each data row and bulids up a final string in a form the clipboard will recognise as the final output data Excel range
Dim RCnt As Long: Let RCnt = 2
Dim strClp As String: Let strClp = "ReptClms" ' The final string of data output to go in the clipboard to be pasted out. I add a place with ReptClms whgich i replace later with the repeated columns
Do While RCnt < UBound(Ars(), 1) ' Outer Loop - Loops once for each section
Do ' While Ars(RCnt - 1, 1) = Ars(RCnt, 1) ' Inner Loop - loops in each section for as many rows in each section
Let strClp = strClp & vbTab & Ars(RCnt, 6) ' This is buildiung the Yes NA Maybe Real string bit for each section
Let RCnt = RCnt + 1 ' Move a row down in each section or effectiuvely to next section if condition below not met
Loop While Ars(RCnt - 1, 1) = Ars(RCnt, 1)
' At this point we have the Yes NA Maybe Real (and also an extra vbTab at the start which we don't want), but so need to add the other stuff for an output data row
Let strClp = Replace(strClp, "ReptClms" & vbTab, Ars(RCnt - 1, 1) & vbTab & Ars(RCnt - 1, 2) & vbTab & Ars(RCnt - 1, 3) & vbTab & Ars(RCnt - 1, 4) & vbTab, 1, 1, vbBinaryCompare) ' Adding The first four columns of repeated values, and at the same time get rid of the unwanted vbTab
Let strClp = strClp & vbCr & vbLf ' This effectively ads a row in the form recognised by the Clipboard
Let strClp = strClp & "ReptClms"
' Let RCnt = RCnt + 1 ' move a row down to the next section
Loop ' While RCnt < UBound(Ars(), 1)
Let strClp = Left(strClp, Len(strClp) - 10) ' This takes off the 11 characters of vbCr vbLf R e p t C l m s
Rem 2 We have the main output , so stick it in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClp
objDataObject.PutInClipboard
Rem 3 Output main data output
Wst.Paste Destination:=Wst.Range("A2")
Rem 4 the header stuff
'4a) copied headers
Let Wst.Range("A1:D1").Value = Wss.Range("A1:D1").Value
'4b) The consequtive S1 S2 etc stuf
Dim Ss() As Variant ' ' Example given data, we need to get S1 S2 .. S14
Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:N)") ' This gets it
' So, Get the N from what we do know - knowing the column count number for example
Dim CL As String
Let CL = Split(Cells(1, 18 - 4).Address, "$", 3, vbBinaryCompare)(1) ' = N got from like second element, (1), after spliting $N$14 by the $ ($N$14 is the address of cell 1, 14 (0) is "" (1) is N (2) is 14 )
Let CL = Split(Cells(1, 18 - 4).Address, "$")(1)
' 18 is the output data final column count
Dim rngOut As Range: Set rngOut = Wst.Range("A1").CurrentRegion
Let CL = Split(Cells(1, rngOut.Columns.Count - 4).Address, "$", 3, vbBinaryCompare)(1) ' = N got from like second element, (1), after spliting $N$14 by the $ ($N$14 is the address of cell 1, 14 (0) is "" (1) is N (2) is 14 )
Let CL = Split(Cells(1, rngOut.Columns.Count - 4).Address, "$")(1) '
' Or
Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:" & Split(Cells(1, rngOut.Columns.Count - 4).Address, "$")(1) & ")")
Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")

Let Ss() = Evaluate("=""S""" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")

Let Wst.Range("E1").Resize(1, 14).Value = Evaluate("=""S""" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")
End Sub

[DocAElstein]

Some notes in support of this main Forum Thread
https://www.eileenslounge.com/viewtopic.php?f=27&t=39784


later..

[DocAElstein]

Some more notes in support of this main Forum Thread
https://www.eileenslounge.com/viewtopic.php?f=27&t=39784



Sub ClipIt() ' https://www.eileenslounge.com/viewtopic.php?f=27&t=39784
Selection.Copy ' Or Application.SendKeys "^c"
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Dim StringBack As String ' This is for the entire text held for the range in the windows clipboard after a .Copy
.GetFromClipboard: Let StringBack = .GetText()
Let StringBack = Replace(StringBack, vbCr & vbLf, ", ", 1, -1, vbBinaryCompare) ' Binary - derived from the internal binary representations of the characters https://www.eileenslounge.com/viewtopic.php?p=308065#p308065
Let StringBack = Left(StringBack, Len(StringBack) - 2) ' .Copy adds an extra trailing vbCr & vbLf https://www.eileenslounge.com/viewtopic.php?p=303007#p303007
.Clear
.SetText StringBack
.PutInClipboard
End With
Let Selection(1).Offset(1, 1).NumberFormat = "@"
ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
End Sub


more later..



https://www.youtube.com/watch?v=yVgLmj0aojI (https://www.youtube.com/watch?v=yVgLmj0aojI)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg.9k3ShckGnhv9k89Lsaig oO (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg.9k3ShckGnhv9k89Lsaig oO)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg.9k-vfnj3ivI9k8B2r_uRa2 (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg.9k-vfnj3ivI9k8B2r_uRa2)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg)

[DocAElstein]

.c, cxn n

[DocAElstein]

later

[DocAElstein]

later

[DocAElstein]

This is post
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff?p=24114viewfull=1#post24114
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff?p=24114&viewfull=1#post24114
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24114
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24114




In support of these main forum posts
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24048
https://eileenslounge.com/viewtopic.php?p=314920#p314920

Similar to a post or two previously (https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=23983&viewfull=1#post23983), just a bit more complicated, the full text in a cell may have these sort of forms, (4 cell examples are shown)


Address.Country -- PKEY_Address_Country
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
DEFINE_PROPERTYKEY(PKEY_Address_Country, 0xC07B4199, 0xE1DF, 0x4493, 0xB1, 0xE1, 0xDE, 0x59, 0x46, 0xFB, 0x58, 0xF8, 100);
#define INIT_PKEY_Address_Country { { 0xC07B4199, 0xE1DF, 0x4493, 0xB1, 0xE1, 0xDE, 0x59, 0x46, 0xFB, 0x58, 0xF8 }, 100 }


Audio.Compression -- PKEY_Audio_Compression
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
//
//
DEFINE_PROPERTYKEY(PKEY_Audio_Compression, 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03, 10);
#define INIT_PKEY_Audio_Compression { { 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03 }, 10 }


IsSendToTarget -- PKEY_IsSendToTarget
// Type: Boolean -- VT_BOOL
// FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
//
// Provided by certain shell folders. Return TRUE if the folder is a valid Send To target.
DEFINE_PROPERTYKEY(PKEY_IsSendToTarget, 0x28636AA6, 0x953D, 0x11D2, 0xB5, 0xD6, 0x00, 0xC0, 0x4F, 0xD9, 0x18, 0xD0, 33);
#define INIT_PKEY_IsSendToTarget { { 0x28636AA6, 0x953D, 0x11D2, 0xB5, 0xD6, 0x00, 0xC0, 0x4F, 0xD9, 0x18, 0xD0 }, 33 }


TitleSortOverride -- PKEY_TitleSortOverride
// Type: String -- VT_LPWSTR (For variants: VT_BSTR) Legacy code may treat this as VT_LPSTR.
// FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)
//
// This optional string value allows for overriding the standard sort order of System.Title.
// This is very important for proper sorting of music files in Japanese which cannot be
// correctly sorted phonetically (the user-expected ordering) without this field.
// It can also be used for customizing sorting in non-East Asian scenarios,
// such as allowing the user to remove articles for sorting purposes.
DEFINE_PROPERTYKEY(PKEY_TitleSortOverride, 0xF0F7984D, 0x222E, 0x4AD2, 0x82, 0xAB, 0x1D, 0xD8, 0xEA, 0x40, 0xE5, 0x7E, 300);
#define INIT_PKEY_TitleSortOverride { { 0xF0F7984D, 0x222E, 0x4AD2, 0x82, 0xAB, 0x1D, 0xD8, 0xEA, 0x40, 0xE5, 0x7E }, 300 }


What I want is the SCIDS, aHoy, aHoy ( https://www.youtube.com/watch?v=DDg1hy6VhxY&t=110s
https://eileenslounge.com/viewtopic.php?p=314905#p314905 )

I took a more fuller look those,
' https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=24049&viewfull=1#post24049
Sub CheckCharacters() ' Cells A2 A8 A288 A377
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A2").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A8").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A288").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A377").Value)
End Sub ' see worksheet WotchaGotInString 4 Mrz Results
For the results, see worksheet WotchaGotInString 4 Mrz Results in the uploaded workbook
Here again parts around the 4 examples simple text forms
Cell A2

FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
112 I 73
113 D 68
114 : 58
115 32
116 { 123
117 C 67
118 0 48
119 7 55
120 B 66
121 4 52
122 1 49
123 9 57
124 9 57
125 - 45
126 E 69
127 1 49
128 D 68
129 F 70
130 - 45
131 4 52
132 4 52
133 9 57
134 3 51
135 - 45
136 B 66
137 1 49
138 E 69
139 1 49
140 - 45
141 D 68
142 E 69
143 5 53
144 9 57
145 4 52
146 6 54
147 F 70
148 B 66
149 5 53
150 8 56
151 F 70
152 8 56
153 } 125
154 , 44
155 32
156 1 49
157 0 48
158 0 48
"159
" 13
"160
" 10
161 D 68
162 E 69
163 F 70


Cell A8

FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
116 I 73
117 D 68
118 : 58
119 32
120 ( 40
121 F 70
122 M 77
123 T 84
124 I 73
125 D 68
126 _ 95
127 A 65
128 u 117
129 d 100
130 i 105
131 o 111
132 S 83
133 u 117
134 m 109
135 m 109
136 a 97
137 r 114
138 y 121
139 I 73
140 n 110
141 f 102
142 o 111
143 r 114
144 m 109
145 a 97
146 t 116
147 i 105
148 o 111
149 n 110
150 ) 41
151 32
152 { 123
153 6 54
154 4 52
155 4 52
156 4 52
157 0 48
158 4 52
159 9 57
160 0 48
161 - 45
162 4 52
163 C 67
164 8 56
165 B 66
166 - 45
167 1 49
168 1 49
169 D 68
170 1 49
171 - 45
172 8 56
173 B 66
174 7 55
175 0 48
176 - 45
177 0 48
178 8 56
179 0 48
180 0 48
181 3 51
182 6 54
183 B 66
184 1 49
185 1 49
186 A 65
187 0 48
188 3 51
189 } 125
190 , 44
191 32
192 1 49
193 0 48
194 32
195 ( 40
196 P 80
197 I 73
198 D 68
199 A 65
200 S 83
201 I 73
202 _ 95
203 C 67
204 O 79
205 M 77
206 P 80
207 R 82
208 E 69
209 S 83
210 S 83
211 I 73
212 O 79
213 N 78
214 ) 41
"215
" 13
"216
" 10


Cell A288

FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
84 I 73
85 D 68
86 : 58
87 32
88 ( 40
89 F 70
90 M 77
91 T 84
92 I 73
93 D 68
94 _ 95
95 S 83
96 h 104
97 e 101
98 l 108
99 l 108
100 D 68
101 e 101
102 t 116
103 a 97
104 i 105
105 l 108
106 s 115
107 ) 41
108 32
109 { 123
110 2 50
111 8 56
112 6 54
113 3 51
114 6 54
115 A 65
116 A 65
117 6 54
118 - 45
119 9 57
120 5 53
121 3 51
122 D 68
123 - 45
124 1 49
125 1 49
126 D 68
127 2 50
128 - 45
129 B 66
130 5 53
131 D 68
132 6 54
133 - 45
134 0 48
135 0 48
136 C 67
137 0 48
138 4 52
139 F 70
140 D 68
141 9 57
142 1 49
143 8 56
144 D 68
145 0 48
146 } 125
147 , 44
148 32
149 3 51
150 3 51
"151 " 13
"152
" 10


Cell A377

FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)
155 a 97
156 t 116
157 I 73
158 D 68
159 : 58
160 32
161 { 123
162 F 70
163 0 48
164 F 70
165 7 55
166 9 57
167 8 56
168 4 52
169 D 68
170 - 45
171 2 50
172 2 50
173 2 50
174 E 69
175 - 45
176 4 52
177 A 65
178 D 68
179 2 50
180 - 45
181 8 56
182 2 50
183 A 65
184 B 66
185 - 45
186 1 49
187 D 68
188 D 68
189 8 56
190 E 69
191 A 65
192 4 52
193 0 48
194 E 69
195 5 53
196 7 55
197 E 69
198 } 125
199 , 44
200 32
201 3 51
202 0 48
203 0 48
204 32
205 ( 40
206 P 80
207 I 73
208 D 68
209 S 83
210 I 73
211 _ 95
212 T 84
213 I 73
214 T 84
215 L 76
216 E 69
217 _ 95
218 S 83
219 O 79
220 R 82
221 T 84
222 _ 95
223 O 79
224 V 86
225 E 69
226 R 82
227 R 82
228 I 73
229 D 68
230 E 69
231 ) 41
"232 " 13
"233
" 10


The conclusion from examination of those text parts, is that there are no surprises such as strange "invisible coding". The line separator is the typical pair, vbCr & vbLf
So we can simply look at these 4 lines, when thinking of how to get at the SCIDS, (and the second one I show again the whole cell of it, just to remind of how the full strings containing the lines of interest look like)

FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)

Audio.Compression -- PKEY_Audio_Compression
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
//
//
DEFINE_PROPERTYKEY(PKEY_Audio_Compression, 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03, 10);
#define INIT_PKEY_Audio_Compression { { 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03 }, 10 }


So we will check that out in the next post

[DocAElstein]

This is post
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff?p=24124viewfull=1#post24124
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff?p=24124&viewfull=1#post24124
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24124
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24124




In support of these main forum posts
https://www.excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA-CSV-stuff/page12#post24048
https://eileenslounge.com/viewtopic.php?p=314920#p314920

Similar to a post or two previously (https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=23983&viewfull=1#post23983), just a bit more complicated, the full text in a cell may have these sort of forms, (4 cell examples are shown)


Address.Country -- PKEY_Address_Country
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
DEFINE_PROPERTYKEY(PKEY_Address_Country, 0xC07B4199, 0xE1DF, 0x4493, 0xB1, 0xE1, 0xDE, 0x59, 0x46, 0xFB, 0x58, 0xF8, 100);
#define INIT_PKEY_Address_Country { { 0xC07B4199, 0xE1DF, 0x4493, 0xB1, 0xE1, 0xDE, 0x59, 0x46, 0xFB, 0x58, 0xF8 }, 100 }


Audio.Compression -- PKEY_Audio_Compression
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
//
//
DEFINE_PROPERTYKEY(PKEY_Audio_Compression, 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03, 10);
#define INIT_PKEY_Audio_Compression { { 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03 }, 10 }


IsSendToTarget -- PKEY_IsSendToTarget
// Type: Boolean -- VT_BOOL
// FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
//
// Provided by certain shell folders. Return TRUE if the folder is a valid Send To target.
DEFINE_PROPERTYKEY(PKEY_IsSendToTarget, 0x28636AA6, 0x953D, 0x11D2, 0xB5, 0xD6, 0x00, 0xC0, 0x4F, 0xD9, 0x18, 0xD0, 33);
#define INIT_PKEY_IsSendToTarget { { 0x28636AA6, 0x953D, 0x11D2, 0xB5, 0xD6, 0x00, 0xC0, 0x4F, 0xD9, 0x18, 0xD0 }, 33 }


TitleSortOverride -- PKEY_TitleSortOverride
// Type: String -- VT_LPWSTR (For variants: VT_BSTR) Legacy code may treat this as VT_LPSTR.
// FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)
//
// This optional string value allows for overriding the standard sort order of System.Title.
// This is very important for proper sorting of music files in Japanese which cannot be
// correctly sorted phonetically (the user-expected ordering) without this field.
// It can also be used for customizing sorting in non-East Asian scenarios,
// such as allowing the user to remove articles for sorting purposes.
DEFINE_PROPERTYKEY(PKEY_TitleSortOverride, 0xF0F7984D, 0x222E, 0x4AD2, 0x82, 0xAB, 0x1D, 0xD8, 0xEA, 0x40, 0xE5, 0x7E, 300);
#define INIT_PKEY_TitleSortOverride { { 0xF0F7984D, 0x222E, 0x4AD2, 0x82, 0xAB, 0x1D, 0xD8, 0xEA, 0x40, 0xE5, 0x7E }, 300 }


What I want is the SCIDS, aHoy, aHoy ( https://www.youtube.com/watch?v=DDg1hy6VhxY&t=110s
https://eileenslounge.com/viewtopic.php?p=314905#p314905 )

I took a more fuller look those,
' https://www.excelfox.com/forum/showthread.php/2909-Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=24049&viewfull=1#post24049
Sub CheckCharacters() ' Cells A2 A8 A288 A377
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A2").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A8").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A288").Value)
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(Range("A377").Value)
End Sub ' see worksheet WotchaGotInString 4 Mrz Results
For the results, see worksheet WotchaGotInString 4 Mrz Results in the uploaded workbook
Here again parts around the 4 examples simple text forms
Cell A2

FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
112 I 73
113 D 68
114 : 58
115 32
116 { 123
117 C 67
118 0 48
119 7 55
120 B 66
121 4 52
122 1 49
123 9 57
124 9 57
125 - 45
126 E 69
127 1 49
128 D 68
129 F 70
130 - 45
131 4 52
132 4 52
133 9 57
134 3 51
135 - 45
136 B 66
137 1 49
138 E 69
139 1 49
140 - 45
141 D 68
142 E 69
143 5 53
144 9 57
145 4 52
146 6 54
147 F 70
148 B 66
149 5 53
150 8 56
151 F 70
152 8 56
153 } 125
154 , 44
155 32
156 1 49
157 0 48
158 0 48
"159
" 13
"160
" 10
161 D 68
162 E 69
163 F 70


Cell A8

FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
116 I 73
117 D 68
118 : 58
119 32
120 ( 40
121 F 70
122 M 77
123 T 84
124 I 73
125 D 68
126 _ 95
127 A 65
128 u 117
129 d 100
130 i 105
131 o 111
132 S 83
133 u 117
134 m 109
135 m 109
136 a 97
137 r 114
138 y 121
139 I 73
140 n 110
141 f 102
142 o 111
143 r 114
144 m 109
145 a 97
146 t 116
147 i 105
148 o 111
149 n 110
150 ) 41
151 32
152 { 123
153 6 54
154 4 52
155 4 52
156 4 52
157 0 48
158 4 52
159 9 57
160 0 48
161 - 45
162 4 52
163 C 67
164 8 56
165 B 66
166 - 45
167 1 49
168 1 49
169 D 68
170 1 49
171 - 45
172 8 56
173 B 66
174 7 55
175 0 48
176 - 45
177 0 48
178 8 56
179 0 48
180 0 48
181 3 51
182 6 54
183 B 66
184 1 49
185 1 49
186 A 65
187 0 48
188 3 51
189 } 125
190 , 44
191 32
192 1 49
193 0 48
194 32
195 ( 40
196 P 80
197 I 73
198 D 68
199 A 65
200 S 83
201 I 73
202 _ 95
203 C 67
204 O 79
205 M 77
206 P 80
207 R 82
208 E 69
209 S 83
210 S 83
211 I 73
212 O 79
213 N 78
214 ) 41
"215
" 13
"216
" 10


Cell A288

FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
84 I 73
85 D 68
86 : 58
87 32
88 ( 40
89 F 70
90 M 77
91 T 84
92 I 73
93 D 68
94 _ 95
95 S 83
96 h 104
97 e 101
98 l 108
99 l 108
100 D 68
101 e 101
102 t 116
103 a 97
104 i 105
105 l 108
106 s 115
107 ) 41
108 32
109 { 123
110 2 50
111 8 56
112 6 54
113 3 51
114 6 54
115 A 65
116 A 65
117 6 54
118 - 45
119 9 57
120 5 53
121 3 51
122 D 68
123 - 45
124 1 49
125 1 49
126 D 68
127 2 50
128 - 45
129 B 66
130 5 53
131 D 68
132 6 54
133 - 45
134 0 48
135 0 48
136 C 67
137 0 48
138 4 52
139 F 70
140 D 68
141 9 57
142 1 49
143 8 56
144 D 68
145 0 48
146 } 125
147 , 44
148 32
149 3 51
150 3 51
"151 " 13
"152
" 10


Cell A377

FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)
155 a 97
156 t 116
157 I 73
158 D 68
159 : 58
160 32
161 { 123
162 F 70
163 0 48
164 F 70
165 7 55
166 9 57
167 8 56
168 4 52
169 D 68
170 - 45
171 2 50
172 2 50
173 2 50
174 E 69
175 - 45
176 4 52
177 A 65
178 D 68
179 2 50
180 - 45
181 8 56
182 2 50
183 A 65
184 B 66
185 - 45
186 1 49
187 D 68
188 D 68
189 8 56
190 E 69
191 A 65
192 4 52
193 0 48
194 E 69
195 5 53
196 7 55
197 E 69
198 } 125
199 , 44
200 32
201 3 51
202 0 48
203 0 48
204 32
205 ( 40
206 P 80
207 I 73
208 D 68
209 S 83
210 I 73
211 _ 95
212 T 84
213 I 73
214 T 84
215 L 76
216 E 69
217 _ 95
218 S 83
219 O 79
220 R 82
221 T 84
222 _ 95
223 O 79
224 V 86
225 E 69
226 R 82
227 R 82
228 I 73
229 D 68
230 E 69
231 ) 41
"232 " 13
"233
" 10


The conclusion from examination of those text parts, is that there are no surprises such as strange "invisible coding". The line separator is the typical pair, vbCr & vbLf
So we can simply look at these 4 lines, when thinking of how to get at the SCIDS, (and the second one I show again the whole cell of it, just to remind of how the full strings containing the lines of interest look like)

FormatID: {C07B4199-E1DF-4493-B1E1-DE5946FB58F8}, 100
FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
FormatID: (FMTID_ShellDetails) {28636AA6-953D-11D2-B5D6-00C04FD918D0}, 33
FormatID: {F0F7984D-222E-4AD2-82AB-1DD8EA40E57E}, 300 (PIDSI_TITLE_SORT_OVERRIDE)

Audio.Compression -- PKEY_Audio_Compression
// Type: String -- VT_LPWSTR (For variants: VT_BSTR)
// FormatID: (FMTID_AudioSummaryInformation) {64440490-4C8B-11D1-8B70-080036B11A03}, 10 (PIDASI_COMPRESSION)
//
//
DEFINE_PROPERTYKEY(PKEY_Audio_Compression, 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03, 10);
#define INIT_PKEY_Audio_Compression { { 0x64440490, 0x4C8B, 0x11D1, 0x8B, 0x70, 0x08, 0x00, 0x36, 0xB1, 0x1A, 0x03 }, 10 }


So we will check that out in the next post

[DocAElstein]

Later

[DocAElstein]

Later

[DocAElstein]

Later

[DocAElstein]

Later

[DocAElstein]

Some rough Clsid Clipboard notes on this page ( https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55 )









In the first 3 posts is a few links, probably to be added to from time to time, and a few very very rough notes, mainly for me and unlikely useful for anyone else. More useful stuff for others is further down this Page #54 (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page54) , from post #534 (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24117&viewfull=1#post24117)


2007 ht t ps://microsoft.public.word.vba.general.narkive.com/5LFhze6E/clear-office-clipboard-from-vba#post10 Tony Jollans If you are using Office 2000 you do have some indirect access to the Office Clipboard from VBA - but you do not have it in any later versions. In Office 2000 the Office Clipboard is presented as a CommandBar and so you can programmatically manipulate the Controls, for example ... CommandBars("Clipboard").Controls("Clear Clipboard").Execute
In Office XP and later, the Office Clipboard is presented as a Task Pane and the 'back door' has been shut. AFAIK, VBA access to it post-2000 is impossible - I don't think you can even do it with SendKeys (but don't quote me on that).
2007 ht t ps://microsoft.public.word.vba.general.narkive.com/5LFhze6E/clear-office-clipboard-from-vba#post13 Tony Jollans ….. Loosely, what happens is this: when you do a Copy operation the Windows Clipboard is cleared and whatever it is you are copying is placed in the Windows Clipboard. It may be added in several different formats (it's not Really relavant now, but some of them may go onto the clipboard itself, some of them may be pointers for the originating application to act on later request). When you do a Paste, the Windows Clipboard is asked to provide whatever is on it in the format you want and, providing that format is available, it will provide it, but still maintain whatever it holds for you to do further Pastes if you wish. In normal circumstances you should not need to do an explicit emptying of the clipboard yourself.
Separate to all this there is, again (very) loosely, a Windows event fired when something is added to the Windows Clipboard which allows Office to know that it has happened and take a copy for the Office Clipboard. Entirely separate from the Windows Clipboard, the Office Clipboard maintains its own copies of up to 12 (Office 2000) or 24 (later versions) items. Office provides some UI facilities for manipulating the copies it holds but they are not directly available from code and no Paste operation, other than explicitly from the Office Clipboard, will use them. If you do an explicit Paste from the Office Clipboard (via the UI) what actually happens is that a (Windows) Copy operation is triggered to copy from the Office Clipboard to the Windows Clipboard and a (Windows) Paste operation is then triggered to paste from the Windows Clipboard to the specified destination.
I confess myself at a total loss to explain how something that has been removed from the Windows Clipboard can later be Pasted; it can only happen if it has be re-placed (i.e. re-copied) on to the Windows Clipboard again - whether explicitly or implicitly as part of some other operation. So the immediate questions must be: can you verify that your copies have worked? can you verify that your clearing of the Windows clipboard has worked? and what do you do between copying and pasting? -- Enjoy,
ht t ps://microsoft.public.word.vba.general.narkive.com/5LFhze6E/clear-office-clipboard-from-vba#post9 hybrid "thing" offered by Office

May 2010 h tt ps://web.archive.org/web/20100506094659/ht tps://benf.org/excel/officeclip/index.html
ht t ps://web.archive.org/web/20100506094659/http://support.microsoft.com/default.aspx/kb/221190 no joy
May 2008 ht t ps://web.archive.org/web/20080508194547/http://msdn.microsoft.com/en-us/library/ms649052(VS.85).aspx

Jan 2015 RickXL madness https://www.mrexcel.com/board/threads/vba-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.828241/#post-4040646 2 you could paste to either Excel, Notepad or Paint. The clipboard has a native copy for Excel, a text version for Notepad, a bitmap for Paint, an HTML version, an XML version etc etc. According to my recent tests, it seems as if Excel saves about 29 sets of data when you make a copy. When you then try and paste it looks through the list of formats on the clipboard and finds the most suitable one

Aug 2015 htt ps://wellsr.com/vba/2015/tutorials/vba-copy-to-clipboard-paste-clear/ Rory knicked? 2018 Update: With the rollout of Windows 8 and Windows 10, this solution no longer works reliably,



2018 htt ps://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/#post-223256 Masturbator API


12/29/2018 ht t ps://web.archive.org/web/20191220024152/ht tps://docs.microsoft.com/en-us/office/vba/language/concepts/forms/what-is-the-difference-between-the-dataobject-and-the-clipboard The DataObject and the Clipboard both provide a means to move data from one place to another. DataObject is a standard OLE object, while the Clipboard aint

Feb 2019 https://eileenslounge.com/viewtopic.php?p=246740#p246740 3 Reset Clear Clipboard
Feb 2019 https://eileenslounge.com/viewtopic.php?p=246740#p246740 3 My good links Reset Clear Clipboard
https://eileenslounge.com/viewtopic.php?p=246884#p246884 2
https://eileenslounge.com/viewtopic.php?p=246838#p246838 2
https://eileenslounge.com/viewtopic.php?p=246770#p246770 1 with La légende du bouton :)
ht tps://docs.microsoft.com/en-us/office/vba/language/concepts/forms/what-is-the-difference-between-the-dataobject-and-the-clipboard changes to
ht tps://learn.microsoft.com/en-us/office/vba/language/concepts/forms/what-is-the-difference-between-the-dataobject-and-the-clipboard 09/13/2021

Mar 2019 https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c/54960767#54960767 2

Mar 2019 https://eileenslounge.com/viewtopic.php?p=247809#p247809 3 (Clipboard API alternative) array overflow date value Yasser rory
Mar 2019 My last post is best, https://eileenslounge.com/viewtopic.php?p=247809#p247809 , giving further links
Oct 2019 ht tps://social.msdn.microsoft.com/Forums/en-US/48e8c30c-24ee-458e-a873-a4e6e13f5926/dataobject-settext-and-putinclipboard-sequence-puts-invalid-data-hex-63-characters-in-clipboard?forum=isvvba not working so did archive org below which works
htt ps://web.archive.org/web/20200806111619/h ttps://social.msdn.microsoft.com/Forums/en-US/48e8c30c-24ee-458e-a873-a4e6e13f5926/dataobject-settext-and-putinclipboard-sequence-puts-invalid-data-hex-63-characters-in-clipboard?forum=isvvba
That seems to give > ht tp://msdn.microsoft.com/en-us/library/office/ff192913.aspx (How to: Send Information to the Clipboard); which is still as new but it is a redirect 2022 htt ps://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard there as new, and captures first start at Sep 2023 ??
An old capture from Oct 2013 – htt ps://web.archive.org/web/20131003213600/http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
> htt p://msdn.microsoft.com/en-us/library/office/ff194373.aspx (How to: Retrieve Information from the Clipboard). Its dated 2022 currently as redirect htt ps://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/retrieve-information-from-the-clipboard
A archive org from 2013 htt ps://web.archive.org/web/20130113075556/http://ms dn.microsoft.com/en-us/library/office/ff194373.aspx
Maybe this was Rory’s cheat sheet from about 2015 ht tps://www.spreadsheet1.com/how-to-copy-strings-to-clipboard-using-excel-vba.html# VBA does not offer a clipboard object, although Visual Basic 6 did. …. copies just two questions marks to the clipboard when used under Windows 8 and 10 (as tested in September 2015)

April 2019 https://eileenslounge.com/viewtopic.php?p=249755#p249755 4 multiple Clipboard for multiple cells MISTAKE WRONG Yasser was right
https://eileenslounge.com/viewtopic.php?p=249795#p249795 3

Oct 2019 h tt ps://web.archive.org/web/20200806111619/ht tp s://social.msdn.microsoft.com/Forums/en-US/48e8c30c-24ee-458e-a873-a4e6e13f5926/dataobject-settext-and-putinclipboard-sequence-puts-invalid-data-hex-63-characters-in-clipboard?forum=isvvba

Dec 2019 http://eileenslounge.com/viewtopic.php?p=262011#p262011 1
Dec 2019 http://eileenslounge.com/viewtopic.php?f=18&t=33834 2 Clipboard quote multi line cell text Syntax in Windows clipboard, to Paste multi lines in Excel

08/19/2020 h t tps://web.archive.org/web/20220922124033/h t tps://learn.microsoft.com/en-us/windows/win32/dataxchg/clipboard-formats Clipboard Formats


Jan 2021 https://eileenslounge.com/viewtopic.php?p=279659#p279659 1 split clipboard

Jun 2021 https://www.eileenslounge.com/viewtopic.php?p=295816#p295816 1
https://www.eileenslounge.com/viewtopic.php?f=30&t=35100&p=295780#p295780 2 put Text file in Excel Clipboard wonder

Apr 2022 https://www.eileenslounge.com/viewtopic.php?p=294721#p294721 2 Clipboard Convert vertical to horizontal on multiple columns 26 Apr 2022 lost appendix

Jun 2022 https://www.eileenslounge.com/viewtopic.php?p=296145#p296145 2 Power shell not working speakeasy Clipboard first 100 lines text file PowerShell Clipboard
June 2022 https://www.eileenslounge.com/viewtopic.php?p=296126#p296126 3 PowerShell text set clipboard SpeakEasy works not me (snb CreateObject scripting.filesystemobject .opentextfile .readall )

[DocAElstein]

Notes mostly originating from a bomb shell dropped by Mike, (SpeakEasy). The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947)


_ - - - - - - -
Nov 2022 https://www.eileenslounge.com/viewtopic.php?f=27&t=38910&p=301028#p301028 3 Office Windows Clipboard
Nov 2022 https://www.eileenslounge.com/viewtopic.php?p=300947#p300947 1 Mike we only have 1 windows clipboard …… just the Windows clipboard. The Office clipboard is just a specific view ….. the clipboard is owned at any particular point in time by the window (or task) that last placed data in the clipboard. In conjunction with this, an application can request that data it is putting on the clipboard use something called 'deferred render' mode - this means that the data is not actually put on the clipboard at that time, the intended purpose being related to performance - it is only provided when a request to paste the data is made. Data marked for deferred render is removed from the clipboard when the owning window is closed. Excel seems to mark quite a lot of data for deferred rendering .
For a range Excel puts about 30 different formats of the data on the clipboard in the following order https://i.postimg.cc/yJn7hGWq/excelclipboarformats.jpg (https://postimg.cc/yJn7hGWq) 5816 https://i.postimg.cc/Kkzx05g1/excelclipboarformats.png (https://postimg.cc/Kkzx05g1) The 'Office clipboard' and 'Excel clipboard' are just limited viewers of the Windows clipboard. As indicated above, the source application has the responsibility of putting all the formats it deems necessary onto the clipboard. The consuming app iterates that list of formats to see which ones it supports.
so what’s this then (https://www.eileenslounge.com/viewtopic.php?p=300955#p300955) https://www.eileenslounge.com/viewtopic.php?p=300955#p300955 4
so any application can monitor (and display to the best of their ability) the contents of the clipboard*. (* this, by the way, is why you can find a plethora of applets that purport to show the contents of the clipboard such as FreeClipView and ClipDiary (back in the day - XP - Microsoft had their own proper clipboard viewer, but they got rid of it; I suspect because it used the slightly unstable clipboard viewer chain mentioned above; the replacement in Windows 10, which only works if you turn on clipboard history - yes they added a history capability to the OS - lacks features ...)) …. This used to be by inserting a clipboard viewer into the clipboard viewer chain - but this is not as robust as it might be, and is the source of some of the 'bugs' that you refer to (e,g. if applications fail to maintain the clipboard viewer chain properly or if a window in the clipboard viewer chain stops responding to messages). The current best practice method is to create a Clipboard Format Listener, which then receives notifications every time the clipboard changes. Applications are free to display the current contents of the clipboard that they understand in order to show the user what is available to paste. And that's what the Office clipboard is: simply a bespoke view of the Windows clipboard, not an actual separate clipboard. There IS a minor wrinkle to this - the Office clipboard viewer maintains a history of clipboard entries (the clipboard itself can only ever hold one entry). Again without going into the nitty gritty, this history consists of data formats that the Office applications know how to render. This can cause some minor inconsistencies..
something somewhere is telling the clipboard - Indeed. Specifically, the WM_RENDERFORMAT message (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18366&viewfull=1#post18366) - Sent to the clipboard owner if it has delayed rendering a specific clipboard format and if an application has requested data in that format. The clipboard owner must render data in the specified format and place it on the clipboard by calling the SetClipboardData function.
The .Copy method puts a copy of the object you are referencing onto the clipboard, in this case a Range.- and then synthesizes all the supported formats. including the Text format (which it does as the synthesized CF_TEXT format, which always ends CR LF [in fact it is even more clever than that, in that it actually separates Rows with CR LF and columns by Tab])
The DataObject's .SetText method exposed to VBA, on the other hand, expects a straightforward text string
(Oh, and one other thing: .PutInClipboard can perform ... unexpectedly ... on occasion if Windows file explorer is open.)
https://www.eileenslounge.com/viewtopic.php?p=301028#p301028 14
Nov 2022 https://www.eileenslounge.com/viewtopic.php?p=301028#p301028 6 the windows clipboard ….. there is no such thing as an Excel Clipboard, and not even anything that might be considered as similar. _____ This thing, Let Application.CutCopyMode = False , is often said to clear the Excel Clipboard.
How about: It takes it out of the (Windows) Clipboard. So if you do a .Paste nothing will happen, as the (Windows) Clipboard is now empty, and the stupid thing is not as clever as that “Office thing that is similar to a clipboard” (that thing what we might call, for want of a better name, the Office Clipboard) , so it wont remember what was copied before. I note that Let Application.CutCopyMode = False makes the clipboard symbol go from orange to white. So maybe that is an indication of if the (Windows) Clipboard is occupied or not._.____________________________
That “Office thing that is similar to a clipboard” (that thing what we might call, for want of a better name, the Office Clipboard) , seems to hold a copied range including the format, long after other things have been copied , even if Let Application.CutCopyMode = False was used a few times, and even if the workbook from which it was copied has long since been closed. In fact, close Excel, go into Word, take a peek into the Office thing that is similar to a clipboard” (that thing what we might call, for want of a better name, the Office Clipboard) there, and you can also pick that copied Excel range out, and paste that copied Excel range into word. But now things are getting a bit inconsistent and quirky: I am finding that sometimes it will give me the formats and sometimes not, - Oh dear, Microsoft got their clipboard viewer chain in a tangle I expect._.____________________
I have often regarded the .Paste as using the Windows Clipboard, whereas I regarded the Excel .PasteSpecial function as using the Excel Clipboard.
Maybe .Paste is using the (Windows) Clipboard whereas the Excel .PasteSpecial function is just some coding to help you choose which version of the copy in the (Windows) Clipboard that you use.
_ - - - - - - - -

[DocAElstein]

Dec 2022 https://www.eileenslounge.com/viewtopic.php?p=301534#p301534 2 Clipboard Trim Eval Range
https://www.eileenslounge.com/viewtopic.php?p=301761#p301761 2 Hans knatsch

Feb 2023 https://www.eileenslounge.com/viewtopic.php?p=304976#p304976 2 Do While Clipboard Gather unique values in one row for each unique key

May 2023 https://www.eileenslounge.com/viewtopic.php?f=26&t=39715&p=307826#p307826 2 clipboard ramble

Jan 2023 https://www.eileenslounge.com/viewtopic.php?p=303007#p303007 2 Clipboard opps a vbCr & vbLf OopsAvbCr&vbLf.xls
Jan 2023 https://www.eileenslounge.com/viewtopic.php?p=303039#p303039 2
The .Copy method puts a copy of the object you are referencing onto the clipboard, in this case a Range.- and then synthesizes all the supported formats. including the Text format (which it does as the synthesized CF_TEXT format (https://learn.microsoft.com/en-us/windows/win32/dataxchg/clipboard-formats), which always ends CR LF )
The DataObject's .SetText method exposed to VBA, on the other hand, expects a straightforward text string
The .Copy is going to tell the Clipboard that it …. ( it being VBA I think in this case, or possibly Excel as the controlling/"owning thing") …. this it is in charge of the clipboard for the time being. This it is a deferred render entry thing, but if and when it does actually put stuff in The ( Microsoft Windows ) Clipboard, then in the case of a range it is gonna be quite a few formats, (maybe about 30 ) or maybe not?: I mean, as its a deferred render entry thing it might decide to put different things in The ( Microsoft Windows ) Clipboard depending on what is done later to trigger the thing to do what it is deferring doing when it’s the controlling/ "owning thing" ?
So that is maybe something close to what the .Copy is doing.
.SetText and .PutInClipboard
( I am not sure if this is a deferred entry thing or not ? ).
This can’t do anything much other than put text somewhere since that is all you give it: You give it a simple text string. That’s it.
_.___________________________________________I am not 100% sure what you are saying by your reference synthesized CF_TEXT (https://learn.microsoft.com/en-us/windows/win32/dataxchg/clipboard-formats)format.
This is my guess as to what you are saying. :
If I use the .GetFromClipboard and .GetText() from within VBA, then what I get will depend on what was the controlling "owning" thing of the The ( Microsoft Windows ) Clipboard at the time ….
Let me consider the 2 cases relevant here…
_ case1
If .Copy was the owning controlling thing of The ( Microsoft Windows ) Clipboard, then, when it sees the request of .GetFromClipboard from within VBA, it may not quite have the format requested. ….I am trying to understand that link you gave ….. I will take a guess that what is going on in this case1 is this:
It takes one of the formats on the first column from that link you gave which it does have* (*or will have – its deferred entry ....) . It than either makes one of the formats on the second column from that link, or maybe makes one that is not listed there. I don’t know. I do know, and agree with this bit that you said…. it actually separates Rows with CR LF and columns by Tab…..
_ case2
If the DataObject is the owning controlling thing of The ( Microsoft Windows ) Clipboard, ( in other words you did the .SetText and .PutInClipboard thing to put text in The ( Microsoft Windows ) Clipboard) , then …..you put a text in and you will get with the .GetFromClipboard and .GetText() the same text back. Simple as that. ( I am still not sure what of the CF_ things are used though in this case either )











Clsid
https://eileenslounge.com/viewtopic.php?p=314950#p314950 Mike GUID list CLSIDs skids SCIDs
https://eileenslounge.com/viewtopic.php?p=289020#p289020 2 GUIDS CLSIDs in the { } as in CreateObject("New:" & “{aksjjfhaskj}” & "") Oct 2021
https://eileenslounge.com/viewtopic.php?p=286708#p286708 3 CLSID .NET 3.5
https://eileenslounge.com/viewtopic.php?p=289020#p289020 2 clsid Oct 2021 Feb 2016
https://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/#post-223256



API alternative
2012 Looks like first report of it https://web.archive.org/web/20200806111619/https://social.msdn.microsoft.com/Forums/en-US/48e8c30c-24ee-458e-a873-a4e6e13f5926/dataobject-settext-and-putinclipboard-sequence-puts-invalid-data-hex-63-characters-in-clipboard?forum=isvvba
opened a support case with Microsoft as suggested by Kirk Beller…..MS determined the cause to be 'most likely a flaw in our product'. So far, I have had no notification of when or if it might be fixed - MS helped me develop a robust workaround using native Windows API calls instead of a DataObject. These are documented in the following articles:
> http://msdn.microsoft.com/en-us/library/office/ff192913.aspx (How to: Send Information to the Clipboard); - Cant find on archive, but the original gets redirected to a new one from 2022, archived at similar date https://web.archive.org/web/20240421213649/https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard
> http://msdn.microsoft.com/en-us/library/office/ff194373.aspx (How to: Retrieve Information from the Clipboard). – original archived
2013 https://web.archive.org/web/20130113075556/http://msdn.microsoft.com/en-us/library/office/ff194373.aspx The original gets redirected to one from 2022 , archived at a similar date https://web.archive.org/web/20221203234848/https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/retrieve-information-from-the-clipboard
So far no MS article does the 64bit even though the original article has a post 2019 telling about it
2015 https://www.spreadsheet1.com/how-to-copy-strings-to-clipboard-using-excel-vba.html# [I]VBA does not offer a clipboard object, although Visual Basic 6 did. …. copies just two questions marks to the clipboard when used under Windows 8 and 10 (as tested in September 2015)
2015 https://wellsr.com/vba/2015/tutorials/vba-copy-to-clipboard-paste-clear/ Mac as well like Rory’s 2018 Update: With the rollout of Windows 8 and Windows 10, this solution no longer works reliably,
2018 https://web.archive.org/web/20191220024152/https://docs.microsoft.com/en-us/office/vba/language/concepts/forms/what-is-the-difference-between-the-dataobject-and-the-clipboard difference between the DataObject and the Clipboard
2018 https://chandoo.org/forum/threads/clipboard-copy-vba-code-not-working-in-windows-10.37126/#post-223256 Masterbasdor API Post
Mar 2019 My last post is best, https://eileenslounge.com/viewtopic.php?p=247809#p247809 , giving further links
Rory’s Tools https://eileenslounge.com/viewtopic.php?p=246708#p246708

[DocAElstein]

This is post #544
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-Pasting-API-Cliipboard-issues-and-Rough-notes-on-Advanced-API-stuff?p=24117&viewfull=1#post24117
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24117&viewfull=1#post24117
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55#post24117
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55#post24117



Some notes to bring together some "Clsid Clipboard" discussions from approximately here https://eileenslounge.com/viewtopic.php?p=288963#p288963 and here, https://eileenslounge.com/viewtopic.php?p=314925#p314925



Clsid Late Binding
These sort of things:
MSForms.ListBox https://web.archive.org/web/20140610024217/http://excelmatters.com/2013/05/21/transposing-an-array-using-an-in-memory-listbox/
CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}")

MSForms.DataObject https://web.archive.org/web/20140610055224/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

The last one is the most commonly used and known about, at least around the VBA area where I am, or have been, over the last few years

Some notes picked up from smarter people
Mike (SpeakEasy), Hans, Chris : From about here https://eileenslounge.com/viewtopic.php?p=288963#p288963
Microsoft simply hasn't exposed a class name for DataObject. Most object we use do have a class name. For those we can use early binding by setting a reference, or late binding by using GetObject/CreateObject with a class name. DataObject is an exception, so we MUST use its hexadecimal ClassID.
36-character strings: .. It's the formal string representation of the underlying 128bit UUID (which Microsoft tend to refer to as a GUID; a CLSID is just a GUID being used for a specific role - identifying a class object), that representation being 32 hexadecimal digits separated by 4 hyphens ...
We humans are sheltered from them normally, but there are odd occasions where we find we have to use them. Not very often for most users, it has to be said.

Mike (SpeakEasy), from about here https://eileenslounge.com/viewtopic.php?p=314925#p314925
GUID is just a unique identifier. Microsoft use unique identifiers for all sorts of purposes in Windows, and then they are given specific names to better indicate their purpose, hence FMTID in my previous post. The GUIDs you can use with CreateObject are actually knows as CLSIDs (or Class IDs); each and every class on Windows has it's own CLSID, and you can look them all up in the registry under HKEY_CLASSES_ROOT.
In general it offers little benefit compared to using the ProgID (the human readable string, such as word.application), and indeed often obfuscates what is going on (malware writers were big fans ...).

There are, however, a few rare scenarios where it can prove useful. Some COM objects do not have a ProgID. Often such objects are not directly useful to VB/VBA programmers, but some are. The one you use in your example, 1C3B4210-F441-11CE-B9EA-00AA006B1A69, is the userform clipboard object*, so we get a cheap way of simple clipboard access.
( * More accurately the userform dataobject, (Microsoft.Vbe.Interop.Forms.DataObjectClass - this is NOT a ProgID) which provides simple access to the clipboard )



Here is a macro I found a few years back:


' This workbook kept and updated here: (Folder at appBox.com excel fox2 excelfox2@gmail.com RegistryCmdListsWinGimics)
' https://powershell.one/wmi/root/cimv2/stdregprov-EnumKey ' https://www.vbforums.com/showthread.php?552899-Getting-all-sub-keys-from-a-registry-value https://www.vba-tutorial.de/apireferenz/registry.htm
Sub ListCLSIDs() ' http://www.eileenslounge.com/viewtopic.php?f=26&t=22603&p=289007#p289007
Dim Ws As Worksheet: Set Ws = Me ' Set Ws = ActiveSheet
Dim Registry As Object, varKey As Variant, varKeys As Variant
Set Registry = GetObject("winmgmts:\\.\root\default:StdRegProv")
Registry.EnumKey 2147483650#, "SOFTWARE\Classes\CLSID", varKeys ' https://powershell.one/wmi/root/cimv2/stdregprov-EnumKey
Dim Cnt As Long: Let Cnt = 1
For Each varKey In varKeys
' Let Ws.Range("A" & Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row + 1 & "").Value = varKey
Let Cnt = Cnt + 1
Let Ws.Range("A" & Cnt & "").Value = varKey
Next
End Sub

Here is a more recent one from Mike ( Speakeasy https://eileenslounge.com/viewtopic.php?p=314941#p314941 )


Public Const HKEY_CLASSES_ROOT = &H80000000 ' https://eileenslounge.com/viewtopic.php?p=314945#p314945
Public Sub GetCLSIDs_and_ProgIDs() ' https://eileenslounge.com/viewtopic.php?p=314941#p314941

Dim entryArray() As Variant
Dim KeyValue As Variant ' Dim KeyValue As String ..... Automation-errors-The-called-object-has-been-disconnected-from-the-clients - https://eileenslounge.com/viewtopic.php?p=314950#p314950 Mike: The error is somewhat misleading. It is down to the fact that the XP (and presumably Vista and W7, although I can't test them) WMI provider (which gives us the Registry access) handles returning Null differently than the one on W10 https://eileenslounge.com/viewtopic.php?p=314953#p314953
Dim KeyPath As String
Dim x As Long
Dim row As Long

Dim RegistryObject As Object
Dim strComputer As String

strComputer = "."
Set RegistryObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
RegistryObject.EnumKey HKEY_CLASSES_ROOT, "CLSID", entryArray

ActiveSheet.Cells(1, 1).Value = "CLSID"
ActiveSheet.Cells(1, 2).Value = "ProgID"

row = 2
For x = 0 To UBound(entryArray)
RegistryObject.getstringvalue HKEY_CLASSES_ROOT, "CLSID\" & entryArray(x) & "\ProgId", "", KeyValue
If KeyValue <> "" Then
ActiveSheet.Cells(row, 1) = entryArray(x)
ActiveSheet.Cells(row, 2) = KeyValue
row = row + 1
End If
Next x

End Sub


In post #545 (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-Pasting-API-Cliipboard-issues-and-Rough-notes-on-Advanced-API-stuff?p=24127&viewfull=1#post24127), I slightly rearrange those routines above, ( mine and Mike’s Clsid list thing making codings) , just to make them easier to compare, and then in post #547 (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24138&viewfull=1#post24138) I do Some initial comparison thoughts




By the way, back then I did myself the coding below to create an object from the Clsid and then look at the TypeName( object ) . I did that as a geuss on how to get the class name, if it had one. More about that abortion Later (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24137&viewfull=1#post24137)

' https://powershell.one/wmi/root/cimv2/stdregprov-EnumKey ' https://www.vbforums.com/showthread.php?552899-Getting-all-sub-keys-from-a-registry-value
Sub CLSIDsValueNames() '
Dim Ws As Worksheet: Set Ws = Me ' Set Ws = ActiveSheet
Dim RngSel As Range: Set RngSel = Selection
If RngSel.Cells.Count = 1 Then MsgBox prompt:="Please select at least 2 cells in column A": Exit Sub
If RngSel.Cells.Columns.Count <> 1 Then MsgBox prompt:="Please select at least 2 cells in only column A": Exit Sub
If Not RngSel.Cells.Column = 1 Then MsgBox prompt:="Please select at least 2 cells in column A": Exit Sub
Dim stearCel As Range
For Each stearCel In RngSel
Let Ws.Range("B" & stearCel.row & "").Value = "Tried" ' To indicate I tried - this can be useful to see where it crashed
Dim OOPObj As Object
On Error GoTo EyeEyeSkipper
Set OOPObj = CreateObject("New:" & stearCel.Value & "")
Let Ws.Range("D" & stearCel.row & "").Value = TypeName(OOPObj)
Let Application.DisplayAlerts = False
ThisWorkbook.Save ' This is done to save all got so far incase Excel crashes on next loop or below
Let Application.DisplayAlerts = True
On Error Resume Next
OOPObj.Close
On Error GoTo 0
Set OOPObj = Nothing
EyeEyeSkipper:
On Error GoTo -1
On Error GoTo 0
Next stearCel
End Sub

[DocAElstein]

These next couple of codings are mine and Mike’s, as in the last post, but I have just rearranged them a bit and made very minor changes, just to make it a bit easier to compare.

'Public Const HKEY_CLASSES_ROOT = &H80000000 ' https://eileenslounge.com/viewtopic.php?p=314945#p314945 https://www.devhut.net/enumerating-registry-subkeys-using-wmi-in-vba/
Public Sub ListCLSIDs_and_ProgIDs_Mike() ' Mike ' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24128&viewfull=1#post24128
Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets("CLSIDsOldVista4810TZG") ' Set Ws = Me '

Dim RegObject As Object, entryArray() As Variant, KeyValue As Variant ' Dim KeyValue As String ' Mike .... error is somewhat misleading. It is down to the fact that the XP (and presumably Vista and W7, although I can't test them) WMI provider (which gives us the Registry access) handles returning Null differently than the one on W10. Simply change the declaration of KeyValue from Dim KeyValue As String to Dim KeyValue As Variant https://eileenslounge.com/viewtopic.php?p=314953#p314953
' Dim KeyPath As String ' - ??
Dim strComputer As String: Let strComputer = "."
Set RegObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
RegObject.EnumKey &H80000000, "CLSID", entryArray() ' HKEY_CLASSES_ROOT, "CLSID", entryArray()
' Let Ws.Cells(1, 6).Value = "CLSID": Let Ws.Cells(1, 7).Value = "ProgID"
Dim ExRowCnt As Long ' ================================================== ==============================================
For ExRowCnt = 0 To UBound(entryArray())
RegObject.getstringvalue &H80000000, "CLSID\" & entryArray(ExRowCnt) & "\ProgId", "", KeyValue

Let Ws.Range("F" & ExRowCnt + 2 & "") = entryArray(ExRowCnt)
Let Ws.Range("G" & ExRowCnt + 2 & "") = KeyValue
Next ExRowCnt ' ================================================== =================================================
End Sub


Public Sub ListCLSIDs_Me() ' Me http://www.eileenslounge.com/viewtopic.php?f=26&t=22603&p=289007#p289007 ' https://powershell.one/wmi/root/cimv2/stdregprov-EnumKey ' https://www.vbforums.com/showthread.php?552899-Getting-all-sub-keys-from-a-registry-value https://www.vba-tutorial.de/apireferenz/registry.htm
Dim Ws As Worksheet: Set Ws = ThisWorkbook.Worksheets("CLSIDsOldVista4810TZG") ' set ws = Set Ws = Me ' Set Ws = ActiveSheet

Dim RegObject As Object, KeyValues() As Variant, KeyValue As Variant


Set RegObject = GetObject("winmgmts:\\.\root\default:StdRegProv")
RegObject.EnumKey 2147483650#, "SOFTWARE\Classes\CLSID", KeyValues() ' https://powershell.one/wmi/root/cimv2/stdregprov-EnumKey

Dim ExRowCnt As Long ' ================================================== ==============================================
For Each KeyValue In KeyValues()

Let ExRowCnt = ExRowCnt + 1
Let Ws.Range("A" & ExRowCnt + 1 & "") = KeyValue

Next ' ================================================== =================================================
End Sub
' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24127&viewfull=1#post24127

https://i.postimg.cc/FRxkK7Wd/Me-Clsids-Mike-Clsids-Prog-IDs.jpg
https://i.postimg.cc/FRxkK7Wd/Me-Clsids-Mike-Clsids-Prog-IDs.jpg (https://postimg.cc/VrdkGLcm)____ ( https://i.postimg.cc/fLFpJjHk/Me-Clsids-Mike-Clsids-Prog-IDs.jpg)

[DocAElstein]

Later
Post #546 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-Pasting-API-Cliipboard-issues-and-Rough-notes-on-Advanced-API-stuff?p=24137&viewfull=1#post24137
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24137&viewfull=1#post24137
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55#post24137
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page55#post24137

My object creating abortion
In the coding of mine, ( Public Sub ListCLSIDs_Me() or Sub ListCLSIDs() ) , I only got the list of the 36 characters in the squiggly bracket , { } things. ( I did not know for sure how to get the name )
But I was interested in the name thing. So as I was not sure how to do it, I wrote , back then, that second program, Sub CLSIDsValueNames() to try and get that name somehow. It basically creates the object, or tries to, and if it is successful, it tries to get the TypeName( object ) of that object.
It works just on the selection you make in column A, the 36 characters in the squiggly bracket , { } things.
Back then, I did a few . but, I broke off from doing it for all the 6527 things, as after doing a few, some applications started appearing after a computer restart, and I had to tank them from the Task Manager.
But for the ones I did do so far, there is some similarity between what I get for my
____ = TypeName( the created object )
, and what Mike effectively gets from these 2 lineyMike’s
RegObject.getstringvalue &H80000000, "CLSID" & entryArray(ExRowCnt) & "\ProgId", "", KeyValue
Prog = KeyValue

Here, just as example, some of the first results
https://i.postimg.cc/2jGKt0dz/Mine-and-Mikes-initial-results.jpg
https://i.postimg.cc/htkym6n0/Mine-and-Mikes-initial-results.jpg
https://i.postimg.cc/ncwwFMwg/Mine-and-Mikes-initial-results.jpg
https://i.postimg.cc/tgFrNkCG/Mine-and-Mikes-initial-results.jpg
https://i.postimg.cc/76DKszfG/Mine-and-Mikes-initial-results.jpg
https://i.postimg.cc/76DKszfG/Mine-and-Mikes-initial-results.jpg (https://postimages.org/)

Check out also the worksheet named CLSIDsOldVista4810TZG in this file
CLSDsUndClassNames.xls - https://app.box.com/s/nkjwti5yym9j0v634hrxerz4x7n1o90w

Here again that abortion of a coding


Sub CLSIDsValueNames() '
Dim Ws As Worksheet: Set Ws = Me ' Set Ws = ActiveSheet
Dim RngSel As Range: Set RngSel = Selection
If RngSel.Cells.Count = 1 Then MsgBox prompt:="Please select at least 2 cells in column A": Exit Sub
If RngSel.Cells.Columns.Count <> 1 Then MsgBox prompt:="Please select at least 2 cells in only column A": Exit Sub
If Not RngSel.Cells.Column = 1 Then MsgBox prompt:="Please select at least 2 cells in column A": Exit Sub
Dim stearCel As Range
For Each stearCel In RngSel
Let Ws.Range("B" & stearCel.row & "").Value = "Tried" ' To indicate I tried - this can be useful to see where it crashed
Dim OOPObj As Object
On Error GoTo EyeEyeSkipper
Set OOPObj = CreateObject("New:" & stearCel.Value & "")
Let Ws.Range("D" & stearCel.row & "").Value = TypeName(OOPObj)
Let Application.DisplayAlerts = False
ThisWorkbook.Save ' This is done to save all got so far incase Excel crashes on next loop or below
Let Application.DisplayAlerts = True
On Error Resume Next
OOPObj.Close
On Error GoTo 0
Set OOPObj = Nothing
EyeEyeSkipper:
On Error GoTo -1
On Error GoTo 0
Next stearCel
End Sub

[DocAElstein]

Some initial comparison thoughts

Here again the two macros in their slightly rearranged and modified form to help compare
https://i.postimg.cc/rskdx3bT/Me-Clsids.jpg https://i.postimg.cc/VN20LdWd/Me-Clsids-Mike-Clsids-Prog-IDs.jpg https://i.postimg.cc/RC7J4C6Z/Mike-Clsids-Prog-IDs.jpg
https://i.postimg.cc/QBkdfNP3/Me-Clsids-Mike-Clsids-Prog-IDs.jpg (https://postimg.cc/QBkdfNP3) 5814
https://i.postimg.cc/VN20LdWd/Me-Clsids-Mike-Clsids-Prog-IDs.jpg (https://postimg.cc/QBkdfNP3)
https://i.postimg.cc/FRxkK7Wd/Me-Clsids-Mike-Clsids-Prog-IDs.jpg (https://postimg.cc/VrdkGLcm)

The registry object looks the same. Its Getted as an object like these
Mike _ "winmgmts:{impersonationLevel=impersonate}!" & strComputer & "\root\default:StdRegProv"
Me ___________________ "winmgmts:\\.\root\default:StdRegProv"

My code I cobbled together a bit wildly. I am not sure yet how Mike got his

We both do a .EnumKey thing referencing the CLSID which gives us an array back of a Variant types, (0 to 6525) . I use a variable KeyValues() , Mike uses a variable entryArray() . Those arrays are identical , perhaps as expected as the FONT=Courier New].EnumKey [/FONT] thing is very similar
___ .EnumKey &H80000000, "CLSID", entryArray() - Mike
.EnumKey 2147483650#, "SOFTWARE\Classes\CLSID", KeyValues() - Me

The array ( Me - KeyValues() , Mike entryArray() ) has exclusively strings in it, the first is just the word CLSID ,the rest of the 6525 are those 36 characters in the squiggly bracket , { } things.
We both effectively loop them strings out. I do just that. Mike makes that the first column that, ( and also Mike makes a second column, which appears to get the name you would use in the late binding thing CreateObject("name") thing. )

Squiggly bracket , { } thing
Regarding that thing in the Mike first of two columns, (the only thing my first macro does), so it is that 36 characters in the squiggly bracket , { } things. I ended up putting each squiggly bracket , { } thing in a variable KeyValue, getting each one out of my KeyValues() . Mike just loops out directly each of his entryArray() (He does in his original coding give that the heading, CLSID

The name you would use in the late binding thing CreateObject("name") thing.
My second abortion coding, Sub CLSIDsValueNames() (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24137&viewfull=1#post24137) , attempted to get that. It did not work too well, but got something similar sometimes.
Mike gets that as well in his coding.
( Mike strangely uses the variable name KeyValue , for the name thing. Whereas I use the variable name KeyValue for the other thing, the squiggly bracket , { } things, which Mike uses no variable for but they comes from his entryArray() and he gives his first column the name CLSID . It is a bit pedantic perhaps, but I might like to think a bit more about the better more appropriate variable name as it can help understand/ remember what is going on **)
Mike gets the name effectively from a line each time inside the loop
.getstringvalue &H80000000, "CLSID" & entryArray(ExRowCnt) & "\ProgId", "", KeyValue


**Maybe one or both of us could do better with the name of our variables to make things more clear ??

Maybe later thoughts, …… later ….
For now I will post , at eileenslounge, and wait a while, in case someone Smarter has any comments.
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (] here [/url)
https://eileenslounge.com/viewtopic.php?p=316705#p316705







( A few other for later, later thoughts ….._
_..... there is one obvious similarity in the two macros, they are using some WimMIe widget gismo thing. This WimMIe widget gismo stuff is a windows lurking thing so I expect you can get in a few ways. I feel a desire to do this sort of thing with PowerShell from within VBA. I’m not sure why yet , - either a simple perversion or some gut feeling that it might be handy later …. Not quite sure why yet … just a feeling in my bones that it could be useful )







Share ‘CLSDsUndClassNames.xls’ [url]https://app.box.com/s/nkjwti5yym9j0v634hrxerz4x7n1o90w

[DocAElstein]

This is post https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page54#post24118
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page54#post24118





Another look at the abortion , 2024
I decided to risk it and went through all the squiggly bracket , { } things in the macro that tries to make an object from them like CreateObject("New:" & squiggly bracket { } thing & "")
It wasn’t so bad, - no new strange things appeared permanently
There were a few crashes which I either let Excel restart itself or I tanked the crashed Excel with the Task Manage r and restarted. ( It happened so much that I got the thing you get after a lot of crashes https://i.postimg.cc/t4w5CTYY/Wir-bedauern-die-Crashing.jpg )
A few other things I noticed.
There were a few hangs, not many
The OLE wait thing ( https://i.postimg.cc/Vkdg8Msx/OLE-waiting.jpg ) popped up few times. Hitting the OK usually moved it on. Occasionally once was enough but 3 times was most commonly required
Excel 2003 tried to install or configure a few times.
Some strange Xceed Encryption Library also appeared a few times https://i.postimg.cc/NGkp7BPz/Xceed-Encryption-Library.jpg



I was not quite so brilliant with VBA coding as I am now back when I wrote that first abortion coding, and also I thought it might be good to get some error messages. So I did another
Sub CLSIDsValueNames2() ' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page54#post24118
Dim Ws As Worksheet: Set Ws = Me ' Set Ws = ActiveSheet
Dim RngSel As Range: Set RngSel = Selection
' If RngSel.Cells.Count = 1 Then MsgBox prompt:="Please select at least 2 cells in column A": Exit Sub
If RngSel.Cells.Columns.Count <> 1 Then MsgBox prompt:="Please select only in column A": Exit Sub
If Not RngSel.Cells.Column = 1 Then MsgBox prompt:="Please select at least 1 cell in column A": Exit Sub
Dim stearCel As Range
For Each stearCel In RngSel
Let Ws.Range("D" & stearCel.Row & "") = ""
Let Ws.Range("B" & stearCel.Row & "") = "Tried" ' To indicate I tried - this can be useful to see where it crashed
Dim OOPObj As Object
On Error GoTo Bed
Set OOPObj = CreateObject("New:" & stearCel.Value & "")
On Error GoTo 0
On Error GoTo Bed2
Let Ws.Range("D" & stearCel.Row & "") = Ws.Range("D" & stearCel.Row & "") & TypeName(OOPObj)
On Error GoTo 0
Skipper:
On Error Resume Next
OOPObj.Close
On Error GoTo 0
Set OOPObj = Nothing
Next stearCel
Exit Sub
Bed: ' Error on create object
Let Application.DisplayAlerts = False
ThisWorkbook.Save ' This is done to save all got so far in the case of an error
Let Application.DisplayAlerts = True
Let Ws.Range("D" & stearCel.Row & "") = "Error on creat object " & Err.Description & " " & Err.Number
Resume Next
Bed2: ' Error on TypeName
Let Ws.Range("D" & stearCel.Row & "") = Ws.Range("D" & stearCel.Row & "").Value & " Error on type name " & Err.Description & " " & Err.Number
On Error GoTo -1
On Error GoTo 0
GoTo Skipper
End Sub

Sub SpeakEasy()
Dim objIE As Object
Set objIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
MsgBox TypeName(objIE)
End Sub
Sub RegyRead()
Dim key As String, RegRead As String
Let key = "{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Dim Ws As Object

Set Ws = CreateObject("WScript.Shell")
RegRead = Ws.RegRead(key)

Set Ws = Nothing

End Sub

It tells me the error if the object could not be made (if the CreateObject("New:" & squiggly bracket { } thing & "") line errors ) , ( as well if the object making seemed ok, but then the TypeName(object) errors - that situation occurs rarely)
( Also in column C, I added some extra notes about things that happened. I may be a cell or two out on when it happened, but if that is the case, I mention that I am not sure )
Here are the things that happened
https://i.postimg.cc/BQfvbmK9/OLE-waiting.jpg
https://i.postimg.cc/mgb2Nhjm/One-Note-help.jpg
https://i.postimg.cc/50Z2w3Kz/Other-version-of-runtime-is-already-loaded-v2-0-50727.jpg
https://i.postimg.cc/Kv78MtPK/Programmzuordnung-festlegen.jpg
https://i.postimg.cc/pdcTdxDq/Research-task-pane.jpg
https://i.postimg.cc/0Q6NM3nx/Speech-pop-up.jpg
https://i.postimg.cc/SQMsmBjf/Unable-to-connect-to-the-Synaptics-Pointing-device-Driver.jpg
https://i.postimg.cc/1Xw5Mqbj/Videoimport.jpg
https://i.postimg.cc/9QJXxVNC/Xceed-Encryption-Library.jpg




The version thing is inconsistent, not always happening , as are both some of the crashes , and some of the number of times an "OLE" pop up needs to be clicked on to move on . But I think I have a 90% good report of what would happen.

https://i.postimg.cc/wvhhP0yX/Results-Sub-CLSIDs-Value-Names2.jpg
https://i.postimg.cc/nhPYQsfD/Results-Sub-CLSIDs-Value-Names2.jpg
https://i.postimg.cc/76v3mp6P/Results-Sub-CLSIDs-Value-Names2.jpg
582258235824
https://i.postimg.cc/wvhhP0yX/Results-Sub-CLSIDs-Value-Names2.jpg (https://postimages.org/)
https://i.postimg.cc/nhPYQsfD/Results-Sub-CLSIDs-Value-Names2.jpg (https://postimages.org/)
https://i.postimg.cc/76v3mp6P/Results-Sub-CLSIDs-Value-Names2.jpg (https://postimg.cc/Ty95PNgB)

[DocAElstein]

Problem getting links to this post

[DocAElstein]

Problem getting links to this post

[DocAElstein]

mmd,,dndak

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854 (https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854)
https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875 (https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316057#p316057 (https://eileenslounge.com/viewtopic.php?p=316057#p316057)
https://eileenslounge.com/viewtopic.php?p=315915#p315915 (https://eileenslounge.com/viewtopic.php?p=315915#p315915)
https://eileenslounge.com/viewtopic.php?p=316705#p316705 (https://eileenslounge.com/viewtopic.php?p=316705#p316705)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=176255#p176255 (https://eileenslounge.com/viewtopic.php?p=176255#p176255)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

xnm ccy cy

[DocAElstein]

xvndvndvn

[DocAElstein]

IIRC for Office 2013 or later, you need to use CommandBars("Office Clipboard") rather than CommandBars("Task Pane")Hi, Mr Rory.
Since this Thread in 2019, I have used various variations of codings discussed here, across Office (Windows) versions 2003 2007 2010 2013 and 2016, and also over the last day or two I have done a few more experiments and reviews in the light of a more recent similar Thread: https://eileenslounge.com/viewtopic.php?f=27&t=41223.
I am finding consistently that it appears that "Task Pane" is needed for codings to work in Office 2003, whereas so far in all cases the same codings need "Office Clipboard" for Offices 2007 2010 2013 and 2016. I strongly suspect that "Office Clipboard" is needed for newer Office versions also based on the codings that appear to work for others with the newer versions. Is it therefore a reasonable assumption that for 2003 and lower "Task Pane" is needed, whereas "Office Clipboard" for all above?
( Have you noticed that some much smaller codings have appeared in the meantime
https://stackoverflow.com/questions/64066265/clearing-the-clipboard-in-office-365/64946949#64946949
* https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633
( https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=17966&viewfull=1#post17966
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24879&viewfull=1#post24879 ) I am not sure where they originated? Possibly Jaafar Tribak * ?
I tried to figure out what these where doing and had not a clue but I remember it causing me to have a strange dream of being in the dark in solitary confinement and trying to play a form of Squash / whack-a-mole with a piece of dried excrement, and a more recent enlightenment (https://eileenslounge.com/viewtopic.php?p=319225#p319225) suggest I may not have been so far off with my thinking. )

_.______________________________-

By the way, in all the codings kicking around, this literal name issue plays a fairly minor role. Its needed to make sure the Offices Clipboard Viewer Pane thing (https://eileenslounge.com/viewtopic.php?p=246730#p246730)is open/ showing (https://i.postimg.cc/XJ8M9TfS/WORD-2003-and-2007-Office-Clipboard.jpg). As an alternative we can use Let Application.DisplayClipboardWindow = True. I am not sure what the relative merits are, although I would have a tendency to go with earlier more fundamental stuff. But I don’t know what is the earlier more fundamental of the two ways here. (I noticed in 2003 sometimes the "Task Pane" brought something else up, so I also did the Let Application.DisplayClipboardWindow = True to get over that problem. It does not seem to error if the Offices Clipboard Viewer Pane thing is already open, so maybe it does no harm to include it also as a belt and braces approach)
I suppose perhaps needing the thing open for the meat of the codings to work means the COM wrapper of accessiblies interface we are using is only for active accessiblies

_._______________________________________-

* @Yasser
Hello Yasser,
I think it could be a good and nice idea for you to do a follow up post over at mrexcel in your February 18, 2019 thread (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/), to tell your Arab friend , Jaafar Tribak, about your more recent post here at eileenslounge (https://eileenslounge.com/viewtopic.php?f=27&t=41223).
Jaafar Tribak tried to get you a solution back then, but did not manage it. You seem to have that solution now, ( the one Hans found for you (https://eileenslounge.com/viewtopic.php?p=319159#p319159))
It is interesting that one of Jaafar Tribak's attempts for you, was close * (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633)
Perhaps Jaafar Tribak might have some interesting comments.
( I note that back in February 2019, Jaafar said he only had Office 2013 so for that reason could not help you further, but it appears now that he has Office 2016 (https://i.postimg.cc/Kzkkgnkt/Jaafar-Tribak-has-Office-2016.jpg)



_.________________________________

( One other very minor thing, a small oddity, while I am here, just for completeness. In the review I done of the two similar Threads over the past couple of days, I came across a strange thing. In this thread, (the one we are in now), there was a very monstrous big code offering , ( given from Yasser in a uploaded text file (https://eileenslounge.com/viewtopic.php?p=246715#p246715), and I reproduced it here (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24142&viewfull=1#post24142) with my usual modifications which usually allow _(i) the thing to work also in Office 2003, as well as _(ii) to work in German Office.)
I can only get that to work in the only English Office versions I have, ( Office 2007). I suspect that coding would also work in at least Office 2003, but my usual modification of changing a literal text in the coding of "Clear All" to "Alle löschen" does not seem to help for that particular monster very big coding. This modification gets all the more typical earlier big (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317) Jaafar Tribak codings to work in my German Office, at least for all the Versions that they work in in English Office. )



Alan

[DocAElstein]

Review of a similar older Thread, which failed to solve the problem.




Hi
I thought it might be of general subject interest and helpful for future reference to mention that we had this exact same question from Yasser in 2019 (http://www.eileenslounge.com/viewtopic.php?f=30&t=31849),
(although it took us most of that Thread to figure out what he wanted, which was to get VBA to do something like when we manually click that Clear All Button (http://www.eileenslounge.com/viewtopic.php?p=246730#p246730).
In the meantime we got a bit more insight into what The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947) is really all about: It seems we are not strictly playing with a clipboard here, since there is only one, and that thing often referred to as the Office Clipboard aint really part of the The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947) : What we are doing here is messing with something that makes its own limited copies of things last set to go on The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947), (in many cases, especially in Excel, those things never get there, ( there in the real clipboard that is) until a Paste. )
We are messing with something that could also be described as a specific viewer of the phenomena that is The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947)
Also if you have multiple versions of Office open, they will all make their own independent copy of what is sent or set to be sent to the windows clipboard, but all our coding attempts so far will just clear stuff in the version its running in. That last bit is perhaps an important point that might be worth saying again a bit differently: Say I have Excel open from Office 2003, and I have word open from Office 2007. I then go somewhere, (anywhere, does not have to be anywhere in particular other than in Windows ), and I copy a word, Alan. That now appears in two list, one in each of the open Office versions: https://i.postimg.cc/nrhXLb56/A-Clipboard-like-thing-for-every-open-Office-version.jpg
But if I use just one of the two Clear All Buttons, then it only is cleared from that list. So that is telling us again that each of the two things is monitoring and making its own copy of what is going or set to be going to The Windows Clipboard (https://www.eileenslounge.com/viewtopic.php?p=300947#p300947)
(Some quirky contradiction like things do exist however. For example after using either Clear All button in one of the Offices, you will then no longer be able to do a simple windows Paste operation, even if things were copied from , and are still showing in the list in the other Office. So somehow either button does have the side effect of clearing the windows clipboard)

So there is no single Office Clipboard in the way that there is a single windows clipboard.

I am not trying to be annoyingly pedantic, - I just think it helps to understand things a bit better, which might lead to better and more interesting and clear solutions . Maybe calling it an Office’s Clipboard monitor might be better.
A confusing quirk is that messing with it might effect the thing its monitoring. Maybe a bit like a old analogue pressure meter measuring some very high pressure large gas tank, and because of some badly designed leaking spaghetti dependency chains, if you mess with the monitor you might cause the tank to explode!

Anyways, manipulating any Office’s Clipboard monitor thing in any direct way with VBA I have yet to see done.
Smarter people have told me that third party software that tries to claim to be some clipboard monitor or other are a bit iffy.
I think throughout we are concentrating here on just getting that button clicked, at some higher accessible interface level.
_._________

Back in 2019 we had a few of the mysterious API codings offered, big ones, most of which I think seemed to come from an Arab guy, who is an Author of a lot of these API thingies, Jaafar Tribak. I fiddled around, admittedly blindly, and got a version to work across Office versions 2003 2007 2010, (which was all I had at the time). It’s still was mostly Jaafar Tribak’s big coding and I was/am no the wiser how it works.
In the light of this Thread, and also just re reading all the previous stuff, I did some minor changes/ updates, and this (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317) is probably "my" latest attempt – its still mostly from the mysterious big versions from Jaafar Tribak, which seemed to have been the standard used for many years. )


We hit a brick wall back then, in 2019, as we could not get it working in Office 2016. So Yasser went off to mrexcel.com and got some interesting info from Jaafar Tribak (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/), who tried but failed still to get it working in Office 2016. (Back then he only had Office versions 2007 2010 and 2013)
(That mrexcel thread has got a bit messed up by a forum software update, so I tried to make a repaired summarized copy of it pulling out the important bits here (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11) )

Back in 2019, the persistent error ( In Office 2016 ) with "my" coding and a few of the bigger codings offered by Jaafar Tribak at mrexcel was "Object doesn't support this property or method 'Error 438' " at the line
Call oIA.accDoDefaultAction(vKid).
For all previous Office version, that code line did not error, and that is the code line in the previous big (http://bit.ly/3Yieb6Q) codings that does the clearing, that is to say does the same as manually clicking that Clear All button in the Office’s Clipboard viewer, ( which incidentally must be open for any of the codings so far to work. I noticed on my recent review that it does not always get opened as it should by the previous codings, and I added a small mod that seems to overcome that problem)

The only reason for this Office 2016 problem at the time that Jaafar Tribak could think of was that the hierarchy of the accessible buttons in the office clipboard had changed for Office 2016. My thinking was that something quirky was going on as we weren’t getting at any kid from the relevant interface out of the COM wrapper that should have that interface of the active accessibles…… :innocent:
_.____________


In the meantime I have got some 2013 Office versions and one 2016 versions, so I thought I would
_ a) take a re look at the previous Threads
and
_b) a look at this recent one( the one I am writing in now) (https://eileenslounge.com/viewtopic.php?f=27&t=41223)…..


….. maybe in the next post……

[DocAElstein]

Continued from last post…..

_a) I confirmed all the previous findings, which was that the codings from 2019 were OK for Office up to and including 2013 and then the mentioned problem was also what I got in my Office 2016
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17966
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17968
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17969

_._________________________________

Now _b ), some comments and interesting findings as a result of this recent Thread, the one I am in now (https://eileenslounge.com/viewtopic.php?f=27&t=41223)

So back in early 2019 we were all stuck, even that Arab guru, Jaafar Tribak

Now, this is the interesting thing, consider from back then in 2019, one of Jaafar Tribak’s (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633) / ("my" version of his) (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=17966&viewfull=1#post17966) failed ( failed in Office 2016 ) attempts, ( and I will call this and similar looking ones from now on the more recent appearing small coding to distinguish it from the big (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317) ones that we had all back then been looking at and which had become the standard one used by many people for a long time)

( Note also, that back then, we all seem to have all missed the fact that this small one does actually work in Offices 2003, 2007, 2010, 2013. So we had an alternative coding to the big (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317) ones most people had been using, but we all missed that, because at the time, we were concentrating on getting something to work in Office 2016 )

This is that smaller coding that we missed, and it would have been / (would be still for office 2013 and lower) an alternative to the previously widely used bigger type of codings. (The version here has a few simple modifications from me, just to help in the following comparisons and discussions)

Option Explicit
#If VBA7 Then
Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#Else
Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#End If

Sub small_2019_ClearOfficeClipBoard() ' Slightly modified attempt of Jaafar Tribak from 2019 to do the Clear All button https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17966
Dim avAcc, bClipboard As Boolean, j As Long
Dim MyPain As String
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004"
Let MyPain = "Task Pane"
Else
Let MyPain = "Office Clipboard"
End If
Set avAcc = Application.CommandBars(MyPain) '
Let bClipboard = avAcc.Visible
If Not bClipboard Then
Let avAcc.Visible = True
DoEvents
End If
For j = 1 To 4 ' J= 1, 2, 3, 4
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 2& ' This seems to do the clearing 1& for paste
Let Application.CommandBars(MyPain).Visible = bClipboard '
End Sub
You can see straight away that it has strong similarity to what Hans found (https://eileenslounge.com/viewtopic.php?p=319159&sid=a5636ddee2213f0629c9f46423c324c5#p319159) at stack overflow.
Having read through that stack overflow Thread a few times, I am not totally sure if the people providing the seemingly working answers totally understood what was going on as there seems to be some inconstancy and confusion in their explanations to things such as VBA7 , Win32, Win64 issues.
I certainly don’t claim to know better, but consider these two things:
Mike’s enlightenment (https://eileenslounge.com/viewtopic.php?p=319225&sid=ebb48b7c6dc31daf644a64044fbe5c3f#p319225),
and
what Jaafar Tribak said back in 2019 when he couldn’t get that small 2019 code ( like the one I gave above) to work in Office 2016 ….. I guess the reason for the code not working in office 2016 is that the hierarchy of the accessible buttons in the office clipboard has changed. (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/page-3#post-5229000)….

I am going to take a Layman guess for now that we can forget 32Bit / 64Bit issues, and that this attempt from me could be a new small coding version from me that will do the job from Office 2003 upwards.

I would welcome
_1) any comment s, generally
as well as
_2) if anyone passing could try that coding and tell me if it worked or not and at the same time tell me their version info.
( If it's any help here, the macro Sub WhatAmI()[/FONT] here (] Application.OperatingSystem can give quirky answers in windows 11 (https://eileenslounge.com/viewtopic.php?p=313844#p313844) , so the operating system result may be wrong for if you have Windows 11
___ I don’t know if that macro gets it correct in Office versions 2016, 2019,2021, 2024 or 365, since I don’t have them versions to check. My guess is that it might be a bit iffy for 2016 2019,2024 or 365. )
_3) Based on what we have seen and learnt with these more recent small codings, I wonder if anyone has any ideas on how to get the previous big codings to work on Office 2016 upwards. I ask this because the big codings seem to be doing things a bit differently, and it could be useful to have the different coding available as an alternative, for example to try if for some reason the small ones one day did not work

[DocAElstein]

….. continued from the last two posts…..


I am going to take a Layman guess for now that we can forget 32Bit / 64Bit issues, and that this (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24879&viewfull=1#post24879) attempt from me could be a new small coding version that will do the job from Office 2003 upwards. (It’s in the uploaded File also - Sub small_20202024_ClearOfficeClipBoard_() )
I tested it so far on quite a few computers with operating systems XP, Vista Windows 7 8.1 10 and 11 and Office versions 2003 2007 2010 2013. Unfortunately I only have one higher version Office, 2016. It works on that.
The important difference between mine and what Hans found is just this bit
' coding change for Office versions at -- Office 2016 ==
If CLng(Val(Application.Version)) < 16 Then
' --For Office versions 2003 2007 2010 2013 ----------------------------------------
For j = 1 To 4 ' J = 1 2 3 4
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 2& ' This seems to do the clearing It will NOT error if viewer pain is already Cleared 1& for paste
' ----------------------------------------------------------------------------------
Else
' ==For Office versions 2016 and higher ==============================================
For j = 1 To 7 ' J = 1 2 3 4 5 6 7
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 0& ' This seems to do the clearing It WILL error if viewer pain is already Cleared
End If ' ================================================== =====================
So I have just a slightly changed section for Office 2013 and lower.

I would welcome
_1) any comments, generally
as well as
_2) if anyone passing could try that coding and tell me if it worked or not and at the same time tell me their version info.,( OS and Office). That would be particularly useful for newer versions, also 64 Bit versions if anyone has them.
_3) Based on what we have seen and learnt with these more recent small codings, I wonder if anyone has any ideas on how to get the previous big[/B] (] [B) coding types to work on Office 2016 upwards. I ask this because the big codings seem to be doing things a bit differently, and it could be useful to have the different coding available as an alternative, for example to try if for some reason the small ones one day did not work



Some minor observations:
(_(i) This is perhaps obvious from the discussions so far, but just to make sure and clear: The coding Hans found does not work in Offices 2013 and lower : In the loop at J = 6 I get the run time error '424' Object needed )
_(ii)
the code as written will error if there is nothing in the Office ClipboardI can confirm that also for my coding on my Office 2016. However my coding does not error for Office versions 2013 and lower. Maybe that tells someone something, (of course for Office 2016 and higher my coding and the one Hans found are pretty well doing the same, but for Office 2013 and lower mine does it a bit differently, as seen in the snippet above)
_ (iii) I don’t see any obvious difference in how a typical Offices Clipboard viewer pain looks like across the Office versions 2003 2007 2010 2013 2016 (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24324) that might explain why the coding needs to be different from Office 2016: They all look a bit different to my layman eye?




Alan

[DocAElstein]

Later

[DocAElstein]

A monster big one, I missed, which I expect is a version of the more typical big ones, … that might have been what Rory meant in one of his characteristic quick short answers (https://eileenslounge.com/viewtopic.php?p=246738#p246738), those ones which are not always clear what he is talking about or to what he is referring to ……
He said
..You can also reduce the code (courtesy of Jaafar Tribak) ......., and then he went on to give a more typical big one such as my version of a big one here https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317



Option Explicit

Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hWnd As Long, ByVal dwId As Long, _
riid As tGUID, ppvObject As Object) As Long

Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As Long, _
ByVal cChildren As Long, rgvarChildren As Variant, _
pcObtained As Long) As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpClass As String, ByVal lpCaption As String) As Long

Const CHILDID_SELF = 0&
Const ROLE_PUSHBUTTON = &H2B&
Const WM_GETTEXT = &HD

Type tGUID
lData1 As Long
nData2 As Integer
nData3 As Integer
abytData4(0 To 7) As Byte
End Type

Type AccObject
objIA As IAccessible
lngChild As Long
End Type


Dim lngChild As Long
Dim strClass As String
Dim strCaption As String
'Using Active Accessibility to clear Office clipboard
'Assumption:
'this is running within Word or Excel as a macro, thus the global Application object is available
Sub ClearOfficeClipboard()
Static accButton As AccObject
If accButton.objIA Is Nothing Then '-----
Dim fShown As Boolean, FeelMyPain As String:
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004" mac
Let FeelMyPain = "Task Pane"
Else
Let FeelMyPain = "Office Clipboard"
End If
fShown = CommandBars(FeelMyPain).Visible ' False will mean the viewer pain is not open
If Not (fShown) Then
CommandBars(FeelMyPain).Enabled = True
CommandBars(FeelMyPain).Visible = True
End If
Let accButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd (Application), "Clear All", ROLE_PUSHBUTTON) ' For English Office
If accButton.objIA Is Nothing Then Let accButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd (Application), "Alle löschen", ROLE_PUSHBUTTON) ' For German Office - strangely this does not appear to help in this particular coding
End If '----------------------------------
If accButton.objIA Is Nothing Then
MsgBox "Unable to locate the ""Clear All"" button!"
Else
accButton.objIA.accDoDefaultAction accButton.lngChild ' This appears to do the clearing, but note it sets off all the other functions
End If
End Sub
' Works 2007 english
' Not work 2003, 2013, 2010 2017 German

'Retrieve window class name
Function GetWndClass(ByVal hWnd As Long) As String
Dim buf As String
Dim retval As Long

buf = Space(256)
retval = GetClassName(hWnd, buf, 255)
GetWndClass = Left(buf, retval)
End Function

'Retrieve window title
Function GetWndText(ByVal hWnd As Long) As String
Dim buf As String
Dim retval As Long

buf = Space(256)
retval = SendMessage(hWnd, WM_GETTEXT, 255, buf)
GetWndText = Left(buf, InStr(1, buf, Chr(0)) - 1)
End Function

'The call back function used by EnumChildWindows
Function EnumChildWndProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Dim found As Boolean

EnumChildWndProc = -1
If strClass > "" And strCaption > "" Then
found = StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0 And _
StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0
ElseIf strClass > "" Then
found = (StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0)
ElseIf strCaption > "" Then
found = (StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0)
Else
found = True
End If

If found Then
lngChild = hChild
EnumChildWndProc = 0
Else
EnumChildWndProc = -1
End If
End Function

'Find the window handle of a child window based on its class and titie
Function FindChildWindow(ByVal hParent As Long, Optional cls As String = "", Optional title As String = "") As Long
lngChild = 0
strClass = cls
strCaption = title
EnumChildWindows hParent, AddressOf EnumChildWndProc, 0
FindChildWindow = lngChild
End Function

'Retrieve the IAccessible interface from a window handle
'Reference:Jean Ross,Chapter 17: Accessibility in Visual Basic,Advanced Microsoft Visual Basic 6.0, 2nd Edition
Function IAccessibleFromHwnd(hWnd As Long) As IAccessible
Dim oIA As IAccessible
Dim tg As tGUID
Dim lReturn As Long

' Define the GUID for the IAccessible object
' {618736E0-3C3D-11CF-810C-00AA00389B71}

With tg
.lData1 = &H618736E0
.nData2 = &H3C3D
.nData3 = &H11CF
.abytData4(0) = &H81
.abytData4(1) = &HC
.abytData4(2) = &H0
.abytData4(3) = &HAA
.abytData4(4) = &H0
.abytData4(5) = &H38
.abytData4(6) = &H9B
.abytData4(7) = &H71
End With
' Retrieve the IAccessible object for the form
lReturn = AccessibleObjectFromWindow(hWnd, 0, tg, oIA)
Set IAccessibleFromHwnd = oIA
End Function

'Recursively looking for a child with specified accName and accRole in the accessibility tree
Function FindAccessibleChild(oParent As IAccessible, strName As String, lngRole As Long) As AccObject
Dim lHowMany As Long
Dim avKids() As Variant
Dim lGotHowMany As Long, i As Integer
Dim oChild As IAccessible
FindAccessibleChild.lngChild = CHILDID_SELF
If oParent.accChildCount = 0 Then
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If
lHowMany = oParent.accChildCount
ReDim avKids(lHowMany - 1) As Variant
lGotHowMany = 0
If AccessibleChildren(oParent, 0, lHowMany, avKids(0), lGotHowMany) <> 0 Then
MsgBox "Error retrieving accessible children!"
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If

'To do: the approach described in http://msdn.microsoft.com/msdnmag/issues/0400/aaccess/default.aspx
' are probably better and more reliable
On Error Resume Next
For i = 0 To lGotHowMany - 1
If IsObject(avKids(i)) Then
If StrComp(avKids(i).accName, strName) = 0 And avKids(i).accRole = lngRole Then
Set FindAccessibleChild.objIA = avKids(i)
Exit For
Else
Set oChild = avKids(i)
FindAccessibleChild = FindAccessibleChild(oChild, strName, lngRole)
If Not FindAccessibleChild.objIA Is Nothing Then
Exit For
End If
End If
Else
If StrComp(oParent.accName(avKids(i)), strName) = 0 And oParent.accRole(avKids(i)) = lngRole Then
Set FindAccessibleChild.objIA = oParent
FindAccessibleChild.lngChild = avKids(i)
Exit For
End If
End If
Next i
End Function

Function FindAccessibleChildInWindow(hwndParent As Long, strName As String, lngRole As Long) As AccObject
Dim oParent As IAccessible
Set oParent = IAccessibleFromHwnd(hwndParent)
If oParent Is Nothing Then
Set FindAccessibleChildInWindow.objIA = Nothing
Else
FindAccessibleChildInWindow = FindAccessibleChild(oParent, strName, lngRole)
End If
End Function

'Retrieve the window handle of the task pane
Function GetOfficeTaskPaneHwnd(app As Object) As Long
GetOfficeTaskPaneHwnd = FindChildWindow(app.hWnd, _
"MsoCommandBar", Application.CommandBars("Task Pane").NameLocal)
End Function

'Retrieve the window handle of the clipboard child window inside task pane
'The window title of the clipboard window seems to be language independent,
'making it a better start point to searching our UI element than the task pane window
Function GetOfficeClipboardHwnd(app As Object) As Long
GetOfficeClipboardHwnd = FindChildWindow(app.hWnd, , "Collect and Paste 2.0")
End Function

[DocAElstein]

-

Spare post for later related to these current posts

https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317
.

https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317 [/size]


. .












































https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=320960#p320960 (https://eileenslounge.com/viewtopic.php?p=320960#p320960)
https://eileenslounge.com/viewtopic.php?p=320957#p3209573 (https://eileenslounge.com/viewtopic.php?p=320957#p3209573)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

This is post #551
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56
https://bit.ly/40fepOB

https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317
http://bit.ly/3Yieb6Q


Coding for ease of reference to from some other Thread Posts
https://eileenslounge.com/viewtopic.php?f=30&t=31849&start=20
https://eileenslounge.com/viewtopic.php?f=27&t=41223
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=17969&viewfull=1#post17969
https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/page-3#post-5229031
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/Page55#post24120
https://eileenslounge.com/viewtopic.php?p=321822#p321822 (February 2019 post )
https://eileenslounge.com/viewtopic.php?p=321817#p321817 ( 2024, Post 1 of 3)
https://eileenslounge.com/viewtopic.php?p=321820#p321820 (2024, Post 2 of 3)
https://eileenslounge.com/viewtopic.php?p=321821#p321821 (2024, Part 3 of 3)




The typical big API coding that was used a lot up until at least 2020 to press that Clear All button (https://eileenslounge.com/viewtopic.php?p=246730#p246730)( https://i.postimg.cc/ZRRtvBtx/Clear-All-Button-Offices-Clipboards.jpg )

This coding below given by me here is a slightly updated version of a coding of "mine"** from 2019 ( https://eileenslounge.com/viewtopic.php?p=246770#p246770
https://eileenslounge.com/viewtopic.php?p=246838&sid=d2d055cc22ba802982e1d0771050e2b7#p246838 )
There are Just minor coding changes here, but also some layout/ formatting changes to make a better comparison to a slightly later appearing coding from Jaafar Tribak
https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/page-2#post-5228787
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=17969&viewfull=1#post17969
** "My" coding was based on a few very similar ones offered in a Thread which originated from Jaafar Tribak, but which at that time did not quite work as required. It’s encouraging that my coding is almost identical to that slightly later one from Jaafar Tribak. He, of course, very likely knew what he was doing. I was frantically blindly empirically trying things, along with a bit of blind intuition.
So just to stop people getting upset with me again: Most Credit goes to Jaafar Tribak, its all based on some big API codings around the web which in turn I think probably originally started life as a coding from Jaafar Tribak



' The main source of this coding is API guru Jaafar Tribak. As far as I can tell this big coding was something of a standard until at least the end of the last century. Possibly after that somne smaller ones may have started appearing
' Rory http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&p=246770#p246770
' Don un CK76 https://www.excelforum.com/excel-programming-vba-macros/1217178-clipboard-not-clearing-application-cutcopymode-false.html
' Jaafar Tribak https://www.mrexcel.com/forum/excel-questions/1087948-reset-clear-clipboard-2.html
' Rory and https://excelribbon.tips.net/T008938_Determining_Your_Version_of_Excel.html
' Jack's 'COMsOLEwollupsActivelyEmmbeddedXratedObjectHookMy Bouton version ' https://www.youtube.com/watch?v=jY-PEeX5xYY&t=2s
' FOR NON ENGLISH EXCEL avec moi si vou ple La légende du bouton ' ##### http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&p=246770#p246770
Option Explicit '
Private Type POINTAPI
x As Long: Y As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' VBA7 and Win64 Compiler Constant Two new compiler constants have been introduced to allow code to work across both 32 bit and 64 bit office. The Win64 constant is true if you are in a 64 bit version of office The Win32 constants is also true for 64 bit office The VBA7 constant is true for Office 2010 or later
#If VBA7 Then ' The next 5 lines turn red for Excel 2007 VBA7 Nothing ia red for GB 32 Bit Office 2010 Nothing is red for 64 Bit windows
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#If Win64 Then ' Under is Red in KB Vista 32 Bit
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
#Else ' ' Under is Red in KB Vista 32 Bit
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
#End If
Dim hwndClip As LongPtr
Dim hwndScrollBar As LongPtr
Dim lngPtr As LongPtr
#Else
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Dim hwndClip As Long
Dim hwndScrollBar As Long
#End If
Const GW_CHILD = 5
Const S_OK = 0
' Update Version 2024 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317
Sub big_ClearOffPainBouton() ' aka Sub ClearOfficeClipBoard() ' OhFolloks
' Let Application.DisplayClipboardWindow = True
Dim tRect1 As RECT, tRect2 As RECT
Dim tPt As POINTAPI
Dim oIA As IAccessible
Dim vKid As Variant
Dim lResult As Long
Dim i As Long
Static bHidden As Boolean
Dim MyPain As String 'COMsOLEwollupsActivelyEmmbeddedXratedObjectHookMy BoutonOhFolloks This section makes the coding work in Office 2003 also
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004"
Let MyPain = "Task Pane"
Else
Let MyPain = "Office Clipboard"
End If

If CommandBars(MyPain).Visible = False Then
bHidden = True
CommandBars(MyPain).Visible = True ' Opens the viewer thing for the Office clipboard on XL 2007 + but sometimes opens the OfficeOnline in XL 2003?
Let Application.DisplayClipboardWindow = True ' Just incase the last line did not work
Application.OnTime Now + TimeValue("00:00:01"), "big_ClearOffPainBouton": Exit Sub
End If

Let hwndClip = FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString)
Let hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars(MyPain).NameLocal)
Let hwndClip = GetNextWindow(hwndClip, GW_CHILD)
Let hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD)

If hwndClip And hwndScrollBar Then
GetWindowRect hwndClip, tRect1
GetWindowRect hwndScrollBar, tRect2
BringWindowToTop Application.hwnd
For i = 0 To tRect1.Right - tRect1.Left Step 50
tPt.x = tRect1.Left + i: tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2
#If VBA7 And Win64 Then
CopyMemory lngPtr, tPt, LenB(tPt)
Let lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
#Else
Let lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
#End If ' ##### avec moi si vou ple La légende du bouton
If InStr("Clear All Borrar todo Effacer tout Alle löschen La légende du bouton", oIA.accName(vKid)) Then
Call oIA.accDoDefaultAction(vKid) ' This does the clearing, and
CommandBars(MyPain).Visible = Not bHidden ' this closes the viewer thing for the Office clipboard
Let bHidden = False
Exit Sub
End If
DoEvents
Next i
End If
Let CommandBars(MyPain).Visible = Not bHidden
MsgBox "Unable to clear the Office Clipboard"
End Sub

[DocAElstein]

This is post #552
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24323
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24323
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24323
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24323&viewfull=1#post24323



This smaller coding below is an alternative to the big one in the previous post. (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317)
It’s based on some experiments done by Jaafar Tribak in 2019 (https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/), when he was trying to get a coding to work in Office 2016. Whilst he failed at the time to get a solution to work in Office 2016, some of us possibly overlooked that this basic coding idea worked in Office 2013 and lower.
So we did at least have another smaller alternative solution to the big one in the previous post. (https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24317)


' new small one first occurrance we missed in 2019 at mrexcel https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633
Option Explicit
#If VBA7 Then
Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#Else
Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#End If


' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24323 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24323&viewfull=1#post24323
Sub small_2019_ClearOfficeClipBoard() ' Slightly modified attempt of Jaafar Tribak from 2019 to do the Offices Clipboard Viewer Clear All button https://www.mrexcel.com/board/threads/reset-clear-clipboard.1087948/#post-5228633 https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page11#post17966
Dim avAcc, bClipboard As Boolean, j As Long
Dim MyPain As String
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004"
Let MyPain = "Task Pane"
Else
Let MyPain = "Office Clipboard"
End If
Set avAcc = Application.CommandBars(MyPain) '
Let bClipboard = avAcc.Visible
If Not bClipboard Then
Let avAcc.Visible = True
DoEvents
End If
For j = 1 To 4 ' J= 1, 2, 3, 4
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 2& ' This seems to do the clearing 1& for paste
Let Application.CommandBars(MyPain).Visible = bClipboard '
End Sub

[DocAElstein]

This is post #553
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24324
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24324
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24324&viewfull=1#post243234
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24317&viewfull=1#post24324





Some pics of the Office’s Clipboard Viewer in different versions, (Seen in Excel)

https://i.postimg.cc/vmNJGfNg/Excel-offices-clipboard-Viewer-XL2003.jpg6090
https://i.postimg.cc/vmNJGfNg/Excel-offices-clipboard-Viewer-XL2003.jpg (https://postimages.org/)



https://i.postimg.cc/T18BDGGT/Excel-offices-clipboard-Viewer-XL2007.jpg6091
https://i.postimg.cc/T18BDGGT/Excel-offices-clipboard-Viewer-XL2007.jpg (https://postimages.org/)



https://i.postimg.cc/cHtVCCpD/Excel-offices-clipboard-Viewer-XL2010.jpg6092
https://i.postimg.cc/cHtVCCpD/Excel-offices-clipboard-Viewer-XL2010.jpg (https://postimages.org/)


https://i.postimg.cc/Jh0wwPPC/Excel-offices-clipboard-Viewer-XL2013.jpg6094
https://i.postimg.cc/Jh0wwPPC/Excel-offices-clipboard-Viewer-XL2013.jpg (https://postimages.org/)



https://i.postimg.cc/y8V4jVRd/Excel-offices-clipboard-Viewer-XL2016.jpg6093
https://i.postimg.cc/y8V4jVRd/Excel-offices-clipboard-Viewer-XL2016.jpg (https://postimg.cc/nCwPcf0b)

[DocAElstein]

This is post #554
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24879
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues/page56#post24879
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24879 &viewfull=1#post24879
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=24879 &viewfull=1#post24879



This is my latest attempt as of October 2024 for a small coding version that will work across Office versions from 2003 up to the latest.
For recent discussions, see here
https://eileenslounge.com/viewtopic.php?f=30&t=31849&p=321822#p321822

https://eileenslounge.com/viewtopic.php?f=27&t=41223&p=321817#p321817
https://eileenslounge.com/viewtopic.php?f=27&t=41223&p=321820#p321820
https://eileenslounge.com/viewtopic.php?f=27&t=41223&p=321821#p321821

https://stackoverflow.com/questions/64066265/clearing-the-clipboard-in-office-365/79137208#79137208



Option Explicit https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff?p=24879&viewfull=1#post24879
#If VBA7 Then
Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#Else
Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
#End If
Sub small_20202024_ClearOfficeClipBoard_() ' https://eileenslounge.com/viewtopic.php?p=319159&sid=a5636ddee2213f0629c9f46423c324c5#p319159
Dim avAcc, bClipboard As Boolean, j As Long
Dim MyPain As String
If CLng(Val(Application.Version)) <= 11 Then ' Case 11: "Excel 2003" Windows "Excel 2004" mac
Let MyPain = "Task Pane"
Else
Let MyPain = "Office Clipboard"
End If
Set avAcc = Application.CommandBars(MyPain) '
Let bClipboard = avAcc.Visible ' bClipboard will be false if the viewer pain is not open
If Not bClipboard Then
avAcc.Visible = True ' This opens the Viewer pain. The coding won't work if it is not open
DoEvents: DoEvents
Else
End If
' coding change for Office versions at -- Office 2016 ==
If CLng(Val(Application.Version)) < 16 Then
' --For Office versions 2003 2007 2010 2013 ----------------------------------------
For j = 1 To 4 ' J = 1 2 3 4
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 2& ' This seems to do the clearing It will NOT error if viewer pain is already Cleared 1& for paste
' ----------------------------------------------------------------------------------
Else
' ==For Office versions 2016 and higher ==============================================
For j = 1 To 7 ' J = 1 2 3 4 5 6 7
AccessibleChildren avAcc, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, avAcc, 1
Next
avAcc.accDoDefaultAction 0& ' This seems to do the clearing It WILL error if viewer pain is already Cleared
End If ' ================================================== =====================
Let Application.CommandBars(MyPain).Visible = bClipboard ' Puts the viewer pain back as it was, open or closed
End Sub

[DocAElstein]

Forum Post #post24931 Thread Post 2824
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff?p=24931&viewfull=1#post24931
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff?p=24931&viewfull=1#post24931
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff/page56#post24931
https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues-and-otes-on-API-stuff/page56#post24931




December, 2024, two months later
On and off I have been looking a bit more at all this VBA windows API stuff, and got a few insights, comments etc., in a few places such as here
2024:
http://www.eileenslounge.com/viewtopic.php?p=321821#p321821
http://www.eileenslounge.com/viewtopic.php?p=321838#p321838 It works by ensuring that the 'Clear All' button is displayed on the screen, then searching through the windows hierarchy find the window that represents the panel that contains the button, then obtains the Accessibilty COM interface for that button (by looking for what control with an Accessibility interface is at a specific point, first ensuring that nothing unexpected is covering that point), and then uses that Accessibility interface to invoke the (default) action the button(hopefully the 'Clear All' button). <phew>

It's just a different route to the same thing - the 'small' code walks through the relevant part of the application's accessibility hierarchy instead of having to search for relevant windows, and ends up at the same point - an Accessibility COM interface to the 'Clear All' button (well, depending on the version of Office ...)
http://www.eileenslounge.com/viewtopic.php?p=321985#p321985
http://www.eileenslounge.com/viewtopic.php?p=322029#p322029
http://www.eileenslounge.com/viewtopic.php?p=322075#p322075 …. window from a programmers perspective: …. Parent-Child Relationships: Windows can have hierarchical relationships. A parent window can host multiple child windows, organizing the interface within a main container. This setup is commonly seen in forms containing controls such as buttons, text boxes, or custom graphics elements. ……the Windows API provides us with tools (Win32 API functions such as FindWindow and FindWindowEx)) that let us walk that hierarchy, but they do NOT give us tools to jump direct to any window we want.

But here’s the thing – not every window we see is necessarily a Windows window (by which I mean one that is managed by the OS), and that means the standard functions cannot walk the tree.

This is the root cause of the difference in methodology between ‘big’ and ‘small’ code examples you've been looking at

One is trying to walk the classic hierarchy – and runs into trouble when it hits NetUIHWND, because that is the bottom of the barrel, there are no children. (Which is why Spy+ and all the Spy+ workalikes such as WinSpy fail here – there’s no more hierarchy for them to walk and display)

The other recognises this problem, and works on the fact that the Ribbon interface maintains its own hierarchy, and that hierarchy is sort of exposed by the Accessibility interface (iAccessible). So, instead of walking down the classic windows tree, we walk down the hierarchy presented to the iAccessible interface. It has the same limitations - there is no way to jump direct to a specific element in the hierarchy; you have to use the functions provided by the oleacc dll. (Accessibility can also be used to walk the classical windows hierarchy)
http://www.eileenslounge.com/viewtopic.php?p=322084#p322084

2019 ++
http://www.eileenslounge.com/viewtopic.php?p=321822#p321822

http://www.eileenslounge.com/viewtopic.php?p=322424#p322424

Lists:
http://www.eileenslounge.com/viewtopic.php?p=322050#p322050
http://www.eileenslounge.com/viewtopic.php?p=322151#p322151

http://www.eileenslounge.com/viewtopic.php?f=30&t=41610
http://www.eileenslounge.com/viewtopic.php?p=322238#p322238 2's flippin compliment +1 ?? https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24921&viewfull=1#post24921
http://www.eileenslounge.com/viewtopic.php?p=322270#p322270
http://www.eileenslounge.com/viewtopic.php?p=322357#p322357

Spys and VBA windows aoi
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24913&viewfull=1#post24913
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24908&viewfull=1#post24908
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24914&viewfull=1#post24914
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24909&viewfull=1#post24909
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24915&viewfull=1#post24915
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API/page2
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24921&viewfull=1#post24921
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24922&viewfull=1#post24922 2’s Compliment Function Decimal To Binary conversion
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24922&viewfull=1#post24922
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24923&viewfull=1#post24923

https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24925&viewfull=1#post24925
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24926&viewfull=1#post24926
https://www.excelfox.com/forum/showthread.php/2989-Rough-Notes-and-posts-to-be-referenced-from-elsewhere-on-VBA-Windows-API?p=24932&viewfull=1#post24932


https://stackoverflow.com/questions/64066265/clearing-the-clipboard-in-office-365/79137208#79137208
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgxREWxgx2z2Lza_0st4AaABAg
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgyikSWvlxbWS24NBeR4AaABAg
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgwNiH4hhyrd2UjDK8d4AaABAg
https://www.youtube.com/watch?v=suUqEo3QWus&lc=UgyBXFxnVWT3pqtdqPx4AaABAg
https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3KswxL 3c
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg.8mjgPNoTt_HABa3tnAjh ZU
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4I83Je lY
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa4Pr15N Ut
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg.8xzeMdC8IOGABa6BSa17 3Z