How to plot countries with accurate area?

The area-preserving projections are listed in GeoProjectionData["EqualArea"]. Most of these projections have formulas for the sphere only, but some of them, like "Albers" or "LambertAzimuthal" in WL 12.1 are prepared to handle the ellipsoidal case too, so those should be the most precise ones available.

For example, let us work with the polygon of the US:

pol = Entity["Country", "UnitedStates"]["Polygon"];

This is its area in square meters, found via GeoArea, which uses precise geodesic computations:

QuantityMagnitude[GeoArea[pol], "Meters"^2]
(* 7.93556*10^12 *)

Now project the polygon using the Albers projection on the "ITRF00" ellipsoid, which is the default ellipsoid used by GeoArea:

projpol = GeoGridPosition[pol, {"Albers", "ReferenceModel" -> "ITRF00"}];

In version 12.1 you can use Area directly on the projected polygon, which gives a result in square meters. Note how close it is. The difference is related to the fact that in the projected polygon the edges are straight lines, not geodesics:

Area[projpol]
(* 7.93544*10^12 *)

This uses a spherical approximation, with a sphere of mean radius (mean in the sense of (a+a+b)/3 for the semiaxes a,b of "ITRF00"):

radius = GeodesyData["ITRF00", "MeanRadius"]
(* Quantity[6.37101*10^6, "Meters"] *)

projpolsph = GeoGridPosition[pol, {"Albers", "ReferenceModel" -> radius}];

Now the result is close, but not so much as before:

Area[projpolsph]
(* 7.92844*10^12 *)

Compare with the GeoArea computation on the same sphere:

QuantityMagnitude[GeoArea[pol, GeoModel -> radius], "Meters"^2]
(* 7.92855*10^12 *)

Finally, note that one of the web examples for WL 12 did precisely what you show in your image above:

https://www.wolfram.com/language/12/new-in-geography/country-polygon-distortion-in-the-mercator-projection.html

Perhaps you can extract the boundary of each country from an equal-area projection, such as this:

GeoGraphics[{}, GeoRange -> "World", GeoProjection -> "Hammer", 
 GeoGridLines -> Automatic]

and re-plot each country centered on its associated location determined by the countries in this:

GeoGraphics[{}, GeoRange -> "World", GeoGridLines -> Automatic]